如果手头有一些比较零散的Office Word文件(*.DOC),但是实际需求确实要将这些Word文件合并成一个Word文件,假如说这些零散的文件比较多,那么手工一个一个添加必定会带来麻烦。这时我们就可以使用VBA的相关功能来帮助我们了。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | 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 |
上面的代码具体演示了如何插入一个文档,那么如何批量插入多个文档呢?你可以试试我前面一篇文章《采用插件机制的批量文件扫描及进程处理工具》所介绍的办法,或者像下面这样:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | 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文件。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | 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
Comments are closed.