Word VBA：多文件合并

最新推荐文章于 2025-04-10 22:54:39 发布

VBA-守候

最新推荐文章于 2025-04-10 22:54:39 发布

阅读量2k

点赞数 1

文章标签： word 开发语言 vba msword 编程语言 c# 自动化

本文链接：https://blog.csdn.net/qq_64613735/article/details/131678784

版权

该文章提供了两种使用VBA宏在Word中合并多个文档的方法：一种是通过插入文件功能，另一种是逐个打开文件复制粘贴。每种方法都涉及到文件对话框选择多文件，以及对选定文件的操作。宏代码可以提高批量处理文档的效率。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

一、插入文件方法

二、逐个打开文件复制粘贴

三、操作

一、插入文件方法

Sub word文档合并方法1_插入文件()
    Dim t0 As Single: t0 = Timer
    Dim fDia As FileDialog
    Dim s As String
    Dim file
    Dim i As Long
    
    Set fDia = Application.FileDialog(msoFileDialogFilePicker)
    
    With fDia
        .AllowMultiSelect = True
        .Title = "选择需要合并的Word文件（可多选）："
        With .Filters
            .Clear
            .Add "Word文件", "*.doc*;*.dot*;*.wps"
            .Add "所有文件", "*.*"
        End With
        If .Show Then
            i = .SelectedItems.count
            For Each file In .SelectedItems
                With Selection
                    .InsertFile CStr(file), link:=False
                    '.InsertAfter Chr(13)
                End With
            Next
        End If
    End With
    
    Set doc = Nothing
    Set fDia = Nothing
    
    s = Format(Timer - t0, "合并完成，用时0.000秒")
    s = Format(i, "0个文档") & s
    
    MsgBox s, vbInformation, "提示"
End Sub

二、逐个打开文件复制粘贴

Sub word文档合并方法2_复制粘贴()
    Dim t0 As Single: t0 = Timer
    Dim doc As Document
    Dim doc1 As Document
    Dim fDia As FileDialog
    Dim s As String
    Dim file
    Dim i As Long
    Dim ks As Long
    Dim js As Long
    
    Set doc = ActiveDocument
    Set fDia = Application.FileDialog(msoFileDialogFilePicker)
    
    With fDia
        .AllowMultiSelect = True
        .Title = "选择需要合并的Word文件（可多选）："
        With .Filters
            .Clear
            .Add "Word文件", "*.doc*;*.dot*;*.wps"
            .Add "所有文件", "*.*"
        End With
        If .Show Then
            Application.ScreenUpdating = False
            
            i = .SelectedItems.count
            For Each file In .SelectedItems
                Set doc1 = Documents.Open(file)
                doc1.Range.Copy
                
                ks = doc.Range.End - 1
                js = doc.Range.End
                
                doc.Range(ks, js).Select
                
                Selection.Paste
                
                doc1.Close wdDoNotSaveChanges
            Next
            
            Application.ScreenUpdating = True
        End If
    End With
    
    Set doc = Nothing
    Set fDia = Nothing
    Set doc1 = Nothing
    
    s = Format(Timer - t0, "合并完成，用时0.000秒")
    s = Format(i, "0个文档") & s
    
    MsgBox s, vbInformation, "提示"
End Sub