无法使用宏以正确的顺序将许多 Word 文档合并为一个？

Question

我正在尝试使用 VBA 宏将许多 word 文档合并为一个 word 文档。我写了下面的代码来完成这个任务

Sub MergeDocs()
    Dim rng As Range
    Dim MainDoc As Document
    Dim strFile As String, strFolder As String
    Dim Count As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Pick your folder"
        .AllowMultiSelect = False
        If .Show Then
            strFolder = .SelectedItems(1) & Application.PathSeparator
        Else
            Exit Sub
        End If
    End With
    Set MainDoc = Documents.Add
    strFile = Dir$(strFolder & "*.doc") '
    Count = 0
    Do Until strFile = ""
        Count = Count + 1
        Set rng = MainDoc.Range
        With rng
            .Collapse 0
            If Count > 1 Then
                .InsertBreak 2
                .End = MainDoc.Range.End
                .Collapse 0
            End If
            .InsertFile strFolder & strFile
        End With
        strFile = Dir$()
    Loop
    MsgBox ("Files are merged")
lbl_Exit:
    Exit Sub

这做得很好，只是文档的顺序不正确。

下面是它如何工作的示例。 如果我将文档作为 doc1、doc2、doc3、doc4 合并到一个文档中，那么这个宏会将它们全部合并，但随机顺序为 doc3、doc2、doc4、doc1，因为我希望文档按 doc1、doc2 的顺序排列，文档 3，文档 4。

任何人都可以尝试并帮助我解决这个问题，因为我对 MS-Word 中的 VB 宏没有太多了解。

感谢您的帮助。

谢谢

Answer 1

我已经找到了我的问题的解决方案，并将我的代码发布在此处以供面临类似问题的人使用

Sub MergeDocs()

'用于将多个 Word 文档合并为一个的宏'

'   Variable Declaration'
Dim rng As Range
Dim MainDoc As Document
Dim AllDocs As Variant
Dim strFile As String, strFolder As String
Dim Count As Long

'   Assigning a value for further use in loop'
Count = 1

'   Ask User to select the Folder containing word documents to be merged'
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Pick the To_Be_Merged Documents Folder"
    .AllowMultiSelect = False
    If .Show Then
        strFolder = .SelectedItems(1) & Application.PathSeparator
    Else
        Exit Sub
    End If
End With

Set MainDoc = Documents.Add

'   Calling GetFileList Function  to get all the documents from folder selected'
AllDocs = GetFileList(strFolder & "*.doc")

'   Calling QuickSort Subroutine to sort the array in ascending order'
If IsArray(AllDocs) Then
    Call QuickSort(AllDocs, LBound(AllDocs), UBound(AllDocs))
End If

Select Case IsArray(AllDocs)

    Case True
        MsgBox UBound(AllDocs) & " documents found"
        For Index = LBound(AllDocs) To UBound(AllDocs)
            strFile = AllDocs(Index)
            Count = Count + 1
            Set rng = MainDoc.Range
            With rng
                .Collapse 0
                If Count > 2 Then
                    .InsertBreak 2
                    .End = MainDoc.Range.End
                    .Collapse 0
                End If
                    .InsertFile strFolder & strFile
            End With
        Next Index

    Case False
        MsgBox "No File Found"

End Select
    MsgBox ("Your documents have been merged successfully")

lbl_Exit:
    Exit Sub

End Sub

' 返回与 FileSpec 匹配的文件名数组'

Function GetFileList(FileSpec As String) As Variant

'   Variables declaration'
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound

'   Loop until no more matching files are found
Do While FileName <> ""
    FileCount = FileCount + 1
    ReDim Preserve FileArray(1 To FileCount)
    FileArray(FileCount) = FileName
    FileName = Dir()
Loop
GetFileList = FileArray
Exit Function

'   Error handler

NoFilesFound:
GetFileList = False
End Function

'返回按升序排序的数组'

Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)

'变量声明'

Dim pivot   As Variant
Dim tmpSwap As Variant
Dim tmpLow  As Long
Dim tmpHi   As Long

tmpLow = inLow
tmpHi = inHi

pivot = vArray((inLow + inHi) \ 2)

While (tmpLow <= tmpHi)

    While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
    Wend

    While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
    Wend

    If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
    End If

Wend

If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi

lbl_Exit:
Exit Sub

End Sub

谢谢