Question

我正在尝试将多个Word文件合并为一个。我在MS Excel中的VBA例程中执行此操作。 Word文件都在一个名为“files”的文件夹中，我想在一个上面的文件夹中创建一个新文件“combinedfile.docx”。我面临的问题是关于合并文件后Word进程的行为（无论是否在执行VBA函数后退出）。在某些机器上，此过程正常工作（除了它有第2页，最后一页为空白），而在其他一些机器上，合并文档包含一个空白页，并且进程管理器显示由VBA函数启动的Word进程仍为运行

我不习惯VBA编程，正如您在下面的代码中看到的，我不知道关闭打开的文档并退出打开的Word进程的正确方法。如果有人可以看看我做了什么并提出了解决这个问题的方法，那将会非常有帮助。
我也很想知道这是否是合并多个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

Answer 1

我建议通过以下方式优化您的代码：

仅打开一次WordApp并将文件移入其中而不关闭/重新打开
无需先杀死combineddoc，只会被新文件覆盖
不需要Word.Document对象，所有都可以在Word.Application对象中完成。

因此代码变得更加简单：

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逻辑，以保证按字母顺序检索文件

VBA：将多个Word文件合并为一个后，Microsoft Word进程不会退出

1 个答案: