Excel 邮件合并宏创建的 PDF 不会更改合并字段
PDFs created by Excel Mail merge macro does not change merge fields
我已将一个宏(来源:MailMerge Excel to Word individual files)复制到 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
通过将以下宏添加到您的工作簿,您可以为每个邮件合并记录生成一个 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
按照编码,文件保存在与邮件合并主文档相同的文件夹中,使用假设为文件名数据源中的 'Name' 字段(更改此以适合您的实际字段名称).
非法文件名字符(即“*./:?|”)被替换为下划线。
不清楚你所说的“我想用第一行作为控制器,这样我可以决定合并哪一行”是什么意思。也就是说,如果您指的是包含 'x' 条目的列,则可以使用邮件合并过滤器来包含或排除这些记录。该宏假定您过滤的字段名为 'Filter' 并且您希望使用小写 'x' 来处理这些记录。更改 SQLStatement 行中的详细信息以适合。
请注意重新添加 Word 库引用和重新在代码中可见的注释。
我已将一个宏(来源:MailMerge Excel to Word individual files)复制到 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
通过将以下宏添加到您的工作簿,您可以为每个邮件合并记录生成一个 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
按照编码,文件保存在与邮件合并主文档相同的文件夹中,使用假设为文件名数据源中的 'Name' 字段(更改此以适合您的实际字段名称).
非法文件名字符(即“*./:?|”)被替换为下划线。
不清楚你所说的“我想用第一行作为控制器,这样我可以决定合并哪一行”是什么意思。也就是说,如果您指的是包含 'x' 条目的列,则可以使用邮件合并过滤器来包含或排除这些记录。该宏假定您过滤的字段名为 'Filter' 并且您希望使用小写 'x' 来处理这些记录。更改 SQLStatement 行中的详细信息以适合。
请注意重新添加 Word 库引用和重新在代码中可见的注释。