Word VBA：多文件合并

目录

一、插入文件方法

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

三、操作

---

一、插入文件方法

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

三、操作

按窗口提示选择文件操作即可