如何将另一个文档添加到同一记录的邮件合并
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
使用我在此处找到的用户 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