由 Excel Mail 合并宏创建的 PDF 不会更改合并域

Question

我已经将一个宏(信用：MailMerge Excel到Word单个文件(复制到Excel中，我可以自动将数据从Excel邮件合并到Word Letter中，并将单个文件另存为文件夹中的pdf。

不幸的是，使用宏后，我的 PDF 不包含 Excel 列表的任何内容，但坚持使用邮件合并字段名称。这适用于我创建的所有文件。

此外，我想使用第一行作为控制器，这样我就可以决定合并哪一行(例如，在第一行中带有"x"(。

在这两种情况下都有人可以帮助我吗？特别是我的第一个问题感觉像是一个小错误，但经过几个小时的搜索，我放弃了。:-(

谢谢你的帮助。

Sub RunMailMerge()
Dim wdOutputName, wdInputName, PDFFileName As String
Dim x As Integer
Dim nRows As Integer
wdInputName = ThisWorkbook.Path & "Letter.docx"
Const wdFormLetters = 0, wdOpenFormatAuto = 0
Const wdSendToNewDocument = 0, wdDefaultFirstRecord = 1, wdDefaultLastRecord = 3
'This will get you the number of records "-1" accounts for header
nRows = Sheets("Overview").Range("B" & Rows.Count).End(xlUp).Row - 1
' open the mail merge layout file
Dim wdDoc As Object
Set wdDoc = GetObject(wdInputName, "Word.document")
wdDoc.Application.Visible = False

With wdDoc.MailMerge
.MainDocumentType = wdFormLetters
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
For x = 1 To nRows
With wdDoc.MailMerge.DataSource
.ActiveRecord = x
If .ActiveRecord > .LastRecord Then Exit For
End With
' show and save output file
'cells(x+1,2)references the first cells starting in row 2 and increasing by 1 row with each loop
PDFFileName = ThisWorkbook.Path & "Letter - " & Sheets("Overview").Cells(x + 1, 2) & ".pdf"
wdDoc.Application.Visible = False
wdDoc.ExportAsFixedFormat PDFFileName, 17   ' This line saves a .pdf-version of the mail merge
Next x
' cleanup
wdDoc.Close SaveChanges:=False
Set wdDoc = Nothing
MsgBox "Your pdf('s) has now been saved!"
End Sub

Answer 1

通过将以下宏添加到工作簿中，可以为每个邮件合并记录生成一个 PDF 输出文件。

Sub RunMailMerge()
'Note: A VBA Reference to the Word Object Model is required, via Tools|References
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim StrFolder As String, StrName As String, i As Long, j As Long
Dim strWorkbookName As String: strWorkbookName = ThisWorkbook.FullName
Const StrNoChr As String = """*./:?|": StrName = "Letter.docx"
StrFolder = ThisWorkbook.Path & Application.PathSeparator
If Dir(StrFolder & strDocNm) = "" Then Exit Sub
With wdApp
'Disable alerts to prevent an SQL prompt
.DisplayAlerts = wdAlertsNone
'Display Word - change this to False once the code is running correctly
.Visible = True
'Open the mailmerge main document - set Visible:=True for testing
Set wdDoc = .Documents.Open(Filename:=StrFolder & StrName, ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
With wdDoc
With .MailMerge
'Define the mailmerge type
.MainDocumentType = wdFormLetters
'Define the output
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
'Connect to the data source
.OpenDataSource Name:=strWorkbookName, ReadOnly:=True, _
LinkToSource:=False, AddToRecentFiles:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"User ID=Admin;Data Source=strWorkbookName;" & _
"Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM `Overview$`  WHERE `Filter` = 'x'", _
SubType:=wdMergeSubTypeAccess
'Process all eligible records
For i = 1 To .DataSource.RecordCount
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
'Exit if the field to be used for the filename is empty
If Trim(.DataFields("Name")) = "" Then Exit For
'StrFolder = .DataFields("Folder") & Application.PathSeparator
StrName = .DataFields("Name")
End With
.Execute Pause:=False
'Clean up the filename
For j = 1 To Len(StrNoChr)
StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
Next
StrName = "Letter - " & Trim(StrName)
'Save as a PDF
wdApp.ActiveDocument.SaveAs Filename:=StrFolder & StrName & ".pdf", _
FileFormat:=wdFormatPDF, AddToRecentFiles:=False
wdApp.ActiveDocument.Close SaveChanges:=False
Next i
'Disconnect from the data source
.MainDocumentType = wdNotAMergeDocument
End With
'Close the mailmerge main document
.Close False
End With
'Restore the Word alerts
.DisplayAlerts = wdAlertsAll
'Exit Word
.Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

按照编码，文件将保存到与 mailmerge 主文档相同的文件夹中，使用文件名数据源中的假定"名称"字段(更改此设置以适合您的实际字段名称(。

非法文件名字符(即"*./：？|"(替换为下划线。

不清楚">我想使用第一行作为控制器，这样我就可以决定合并哪一行"是什么意思。也就是说，如果您引用的是带有"x"条目的列，则可以使用 mailmerge 筛选器来包含或排除这些记录。该宏假定您要筛选的字段名为"筛选器"，并且您希望使用小写"x"处理这些记录。更改 SQLStatement 行中的详细信息以使其适合。

请注意注释重新添加 Word 库引用并在代码中重新可见性。