VBScript/VBA批量合并多个Word文件到一个文件

如果手头有一些比较零散的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