MailMerge Excel到Word的单个文件

问题描述

我正在尝试创建以下内容:

I am trying to create the following:

在Excel中存储数据以创建一个邮件合并，并在单个pdf文件中输出，并从数据中获取文件名字母+名称".

In Excel data is stored to create a mailmerge with output in individual pdf files, with file name 'Letter + name' from data.

需要使用Excel中的创建字母"按钮来创建单个文件.

Individual files needs to be created with a button in Excel 'creating letters'.

我快到了，唯一的问题是我创建了单独的pdf文件，但每个文件都具有与第1行相同的数据.

I am almost there, the only problem I have is that I have the individual pdf files created but all with the same data as per row 1.

如何创建具有单独数据的每个文件的单个文件?

How can I create the individual files with each file with separate data?

 Sub RunMailMerge()

 Dim wdOutputName, wdInputName, PDFFileName As String
 Dim x As Integer
 Dim nRows As Integer

wdInputName = ThisWorkbook.Path & "\Templates\LetterExample.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(1).Range("A" & 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


For x = 1 To nRows

With wdDoc.MailMerge
     .MainDocumentType = wdFormLetters
     .Destination = wdSendToNewDocument
     .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
    End With
     .Execute Pause:=False
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(1).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

推荐答案

尝试将您的邮件合并移动到for循环上方，然后逐步浏览for循环内的每个记录集:

Try moving your mailmerge above the for loop and then step through each record set inside the for loop:

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 ActiveDocument.MailMerge.DataSource
     .ActiveRecord = x
     If .ActiveRecord > .LastRecord Then Exit For
  End with

  '.... rest of your for loop

这篇关于MailMerge Excel到Word的单个文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！