如何将另一个文档添加到同一记录的邮件合并

How to Add another document to mail merge for the same record

使用我在此处找到的用户 dandarii 发布的代码,我可以通过邮件合并 word.doc。当邮件合并完成后,我想用相同的记录邮件合并一个单独的 word.doc。我不想将两个 word.doc 合并为一个 word.doc

正在考虑创建一个单独的模块,但感到困惑。是否考虑过 wdDoc 和 wdDoc1?

With wdApp
        .Visible = False

        Set wdDoc = .Documents.Open(filePath & firstDoc)

        'Added Code
        strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

        wdDoc.MailMerge.MainDocumentType = wdFormLetters

        wdDoc.MailMerge.OpenDataSource _
            Name:=strWorkbookName, _
            AddToRecentFiles:=False, _
            Revert:=False, _
            Format:=wdOpenFormatAuto, _
            Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
            SQLStatement:="SELECT * FROM [Sheet1$]"

        With wdDoc.MailMerge
            .Destination = wdSendToNewDocument
            With .DataSource
                .FirstRecord = loopRow - 1
                .LastRecord = loopRow - 1
                .ActiveRecord = loopRow - 1

            End With
            .Execute Pause:=False
        End With

        wdApp.Visible = False

        Set TargetDoc = wdApp.ActiveDocument

        TargetDoc.SaveAs2 Filename:=newFilePath & "\" & newFolderName & "- firstDoc.docx"

        wdDoc.Close SaveChanges:=False```

如果我正确地遵循了要求,我认为将其分为两个过程是有意义的:一个处理循环(在问题的代码中不可见),另一个处理邮件合并.类似于下面的代码片段。

"Top-level" 处理循环和所有内容的过程 Excel(代码摘录,基于相关内容):

With wdApp
    .Visible = False

    Set wdDoc = .Documents.Open(filePath & firstDoc)
    Set wdDoc1 = .Documents.Open(filePath & otherDoc)

    'Added Code
    strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

    ExecuteMailMerge wdDoc, strWorkbookName, loopRow, _
                     newFilePath, newFolderName, firstDoc

    ExecuteMailMerge wdDoc1, strWorkbookName, loopRow, _
                     newFilePath, newFolderName, otherDoc

处理邮件合并的过程:

Sub ExecuteMailMerge(wdDoc As Object, strWorkbookName as String, loopRow as Long, _
                     newFilePath as String, newFolderName as String, docName as String)

    With wdDoc.MailMerge
        .MainDocumentType = wdFormLetters
        .OpenDataSource _
          Name:=strWorkbookName, _
          AddToRecentFiles:=False, _
          Revert:=False, _
          Format:=wdOpenFormatAuto, _
          Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
          SQLStatement:="SELECT * FROM [Sheet1$]"

        .Destination = wdSendToNewDocument
        With .DataSource
            .FirstRecord = loopRow - 1
            .LastRecord = loopRow - 1
            .ActiveRecord = loopRow - 1
        End With
        .Execute Pause:=False
    End With
    Set TargetDoc = wdApp.ActiveDocument

    TargetDoc.SaveAs2 Filename:=newFilePath & "\" & newFolderName & "- " & docName & ".docx"

    wdDoc.Close SaveChanges:=False
End Sub