Question

我已将一个宏（信用卡：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

Answer 1

通过将以下宏添加到工作簿，您可以为每个mailmerge记录生成一个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库引用和可见性。

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

1 个答案: