我正在尝试将多个Word文件合并为一个。 我正在MS Excel中使用VBA例程。 Word文件都在一个名为“文件”的文件夹中，我想在一个文件夹中创build一个新文件“combinedfile.docx”。 我面临的问题是在合并文件后（不pipe它是否在VBA函数执行后退出），Word过程的行为。 在一些机器上，这个过程工作正常（除了页面2和最后一页为空白），而在其他一些机器上，合并的文档包含一个空白页面，进程pipe理器显示由VBA函数启动的Word进程仍然是运行。
我不习惯于VBA编程，正如你可以在下面的代码中看到的，我不知道正确的方式来closures打开的文档，并退出一个开放的Word过程。 如果有人可以看看我已经做了什么，并build议一种方法来解决这个问题，这将是非常有益的。
我也有兴趣知道这是否合并几个Word文件的正确方法。 如果有更好的方法，请让我知道。
'the flow: ' start a word process to create a blank file "combinedfile.docx" ' loop over all documents in "files" folder and do the following: ' open the file, insert it at the end of combinedfile.docx, then insert pagebreak ' close the file and exit the word process filesdir = ActiveWorkbook.Path + "\" + "files\" thisdir = ActiveWorkbook.Path + "\" singlefile = thisdir + "combinedfile.docx" 'if it already exists, delete If FileExists(singlefile) Then SetAttr singlefile, vbNormal Kill singlefile End If Dim wordapp As Word.Application Dim singledoc As Word.Document Set wordapp = New Word.Application Set singledoc = wordapp.Documents.Add wordapp.Visible = True singledoc.SaveAs Filename:=singlefile singledoc.Close 'i do both this and the line below (is it necessary?) Set singledoc = Nothing wordapp.Quit Set wordapp = Nothing JoinFiles filesdir + "*.docx", singlefile Sub JoinFiles(alldocs As String, singledoc As String) Dim wordapp As Word.Application Dim doc As Word.Document Set wordapp = New Word.Application Set doc = wordapp.Documents.Open(Filename:=singledoc) Dim filesdir As String filesdir = ActiveWorkbook.Path + "\" + "files\" docpath = Dir(alldocs, vbNormal) While docpath "" doc.Bookmarks("\EndOfDoc").Range.InsertFile (filesdir + docpath) doc.Bookmarks("\EndOfDoc").Range.InsertBreak Type:=wdPageBreak docpath = Dir Wend doc.Save doc.Close Set doc = Nothing wordapp.Quit Set wordapp = Nothing End Sub 我建议按以下方式优化您的代码：
所以代码变得更简单了：
Sub Merge() Dim WordApp As Word.Application Dim FilesDir As String, ThisDir As String, SingleFile As String, DocPath As String Dim FNArray() As String, Idx As Long, Jdx As Long ' NEW 11-Apr-2013 FilesDir = ActiveWorkbook.Path + "\" + "files\" ThisDir = ActiveWorkbook.Path + "\" SingleFile = ThisDir + "combinedfile.docx" Set WordApp = New Word.Application ' NEW 11-Apr-2013 START ' read in into array Idx = 0 ReDim FNArray(Idx) FNArray(Idx) = Dir(FilesDir & "*.docx") Do While FNArray(Idx) <> "" Idx = Idx + 1 ReDim Preserve FNArray(Idx) FNArray(Idx) = Dir() Loop ReDim Preserve FNArray(Idx - 1) ' to get rid of last blank element BubbleSort FNArray ' NEW 11-Apr-2013 END With WordApp .Documents.Add .Visible = True ' REMOVED 11-Apr-2013 DocPath = Dir(FilesDir & "*.docx") ' REMOVED 11-Apr-2013 Do While DocPath <> "" ' REMOVED 11-Apr-2013 .Selection.InsertFile FilesDir & DocPath ' REMOVED 11-Apr-2013 .Selection.TypeBackspace ' REMOVED 11-Apr-2013 .Selection.InsertBreak wdPageBreak ' REMOVED 11-Apr-2013 DocPath = Dir ' REMOVED 11-Apr-2013 Loop ' NEW 11-Apr-2013 START For Jdx = 0 To Idx - 1 .Selection.InsertFile FilesDir & FNArray(Jdx) .Selection.TypeBackspace .Selection.InsertBreak wdPageBreak Next Jdx ' NEW 11-Apr-2013 END .Selection.TypeBackspace .Selection.TypeBackspace .Selection.Document.SaveAs SingleFile .Quit End With Set WordApp = Nothing End Sub ' NEW 11-Apr-2013 START Sub BubbleSort(Arr) Dim strTemp As String Dim Idx As Long, Jdx As Long Dim VMin As Long, VMax As Long VMin = LBound(Arr) VMax = UBound(Arr) For Idx = VMin To VMax - 1 For Jdx = Idx + 1 To VMax If Arr(Idx) > Arr(Jdx) Then strTemp = Arr(Idx) Arr(Idx) = Arr(Jdx) Arr(Jdx) = strTemp End If Next Jdx Next Idx End Sub ' NEW 11-Apr-2013 END
编辑2013年4月11日删除代码添加数组和原始注释bubblesort逻辑，以保证文件按字母顺序检索