提醒：本页面将不再更新、维护或者支持，文章、评论所叙述内容存在时效性，涉及技术细节或者软件使用方面不保证能够完全有效可操作，请谨慎参考！

如果手头有一些比较零散的Office Word文件（*.DOC），但是实际需求确实要将这些Word文件合并成一个Word文件，假如说这些零散的文件比较多，那么手工一个一个添加必定会带来麻烦。这时我们就可以使用VBA的相关功能来帮助我们了。

Const wdPageBreak = 7 ' 分页符

Dim strFileName
strFileName = "要合并的文件.doc"

Dim strDestFileName
strDestFileName = "最终合并的文件.doc"

Dim wdApp, doc, Selection
Set wdApp = WSH.CreateObject("Word.Application")
wdApp.Visible = False

Set doc = wdApp.Documents.Add

Set Selection = wdApp.Selection
' 这里strFileName直接是要合并的文件路径
' Selection.InsertFile FileName:=strFileName
Selection.InsertFile strFileName
' 跳转到下一页（插入分页符）
' Selection.InsertBreak Type:=wdPageBreak
Selection.InsertBreak wdPageBreak

Set doc = Nothing
doc.SaveAs strDestFileName
doc.Close

Set doc = Nothing
wdApp.Visible = True
wdApp.Quit
Set wdApp = Nothing

上面的代码具体演示了如何插入一个文档，那么如何批量插入多个文档呢？你可以试试我前面一篇文章 《采用插件机制的批量文件扫描及进程处理工具》 所介绍的办法，或者像下面这样：

Option Explicit

Const msoFileTypeWordDocuments = 3

Dim wdApp, FileSearch, i
Set wdApp = WSH.CreateObject("Word.Application")
wdApp.Visible = False

Set FileSearch = wdApp.Application.FileSearch
  With FileSearch
    .NewSearch
    .LookIn = wdApp.ActiveDocument.Path ' 指定搜索路径
    .FileType = msoFileTypeWordDocuments
    
    If .Execute > 0 Then
      For i = 1 To .FoundFiles.Count
        MsgBox .FoundFiles.Item(i) ' 所找到的文件
      Next
    End If
  End With
Set FileSearch = Nothing

wdApp.Visible = True
wdApp.Quit
Set wdApp = Nothing

假如说上面的代码指定路径后就很机械的搜索所有的Word文件，那么下面的这段代码体验上面要好些，其允许用户选择要合并的Word文件。

Option Explicit

Const msoFileDialogFilePicker = 3

Dim wdApp, Dialog
Set wdApp = WSH.CreateObject("Word.Application")
wdApp.Visible = False

  Set Dialog = wdApp.Application.FileDialog(msoFileDialogFilePicker)
    With Dialog
      .Title = "请选择文档（可以多选）"
      .AllowMultiSelect = True
      .Filters.Clear
      .Filters.Add "所有 WORD 文件", "*.doc", 1
    End With
    
    Dim i
    If Dialog.Show Then
      For i = 1 To Dialog.SelectedItems.Count
        MsgBox Dialog.SelectedItems(i) ' 选择的项目
      Next
    End If
  Set Dialog = Nothing
wdApp.Visible = True
wdApp.Quit
Set wdApp = Nothing

END