I feel like I am 90% of the way there, the code opens my word document, correctly sets the data source, completes the mail merge and even names the PDFs correctly by name and path. However each PDF has all three (using limited data for testing) instances/data sets saved to it, so there are three letters in each PDF each mail merged to each recipient. ie Record 1 generates PDF names it Joe Bloggs Letter.pdf, open the PDF and it has a letter for Joe Bloggs, Jane Doe (record 2), and John Smith (record 3). It then generates Record 2, named correctly but again all three letters inside.
How can I adjust my code so that when it completes the mail merge save to PDF there is only one instance/record per PDF and not all three?
Here is my code
`Private Sub CommandButton1_Click()
Dim wdApp As Object
Dim wdDoc As Object
Dim tempDoc As Object
Dim wordDocPath As String
Dim dataSourcePath As String
Dim saveDir As String
Dim savePath As String
Dim lastRow As Long
Dim i As Long
Dim pdfFileName As String
Dim ws As Worksheet
' Define the path to the Word document
wordDocPath = "M:...1. Letter.docx"
' Define the path to the Excel data source
dataSourcePath = "M:...Interview Schedule.xlsm"
' Define the directory for saving the PDF files
saveDir = "M:...2. Letters"
' Set the worksheet where mail merge data is stored
Set ws = ThisWorkbook.Sheets("Mailmerge")
' Get the last row of data in the Mailmerge sheet
lastRow = ws.Cells(ws.Rows.Count, "V").End(xlUp).Row
' Create a new instance of Word
On Error Resume Next
Set wdApp = GetObject(Class:="Word.Application")
If wdApp Is Nothing Then
Set wdApp = CreateObject(Class:="Word.Application")
End If
On Error GoTo 0
wdApp.Visible = True
' Open the Word document
Set wdDoc = wdApp.Documents.Open(wordDocPath)
' Link the Word document to the Excel data source
wdDoc.MailMerge.OpenDataSource _
Name:=dataSourcePath, _
SQLStatement:="SELECT * FROM [Mailmerge$]"
' Loop through each row and perform mail merge
For i = 2 To lastRow ' Assuming data starts from row 2
' Get the PDF file name from column V
pdfFileName = ws.Cells(i, "V").Value
' Perform the mail merge for the current record
With wdDoc.MailMerge
.Destination = 0 ' wdSendToNewDocument
.Execute Pause:=False
' Save the result as a PDF
savePath = saveDir & pdfFileName & ".pdf"
wdApp.ActiveDocument.SaveAs2 Filename:=savePath, FileFormat:=17 ' 17 is the PDF format
' Close the active document without saving changes
wdApp.ActiveDocument.Close SaveChanges:=False
End With
Next i
' Close the original Word document without saving changes
wdDoc.Close SaveChanges:=False
' Quit Word if it was started by this macro
wdApp.Quit
' Release the objects
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "Mail merge completed, and PDFs saved in the specified directory."
End Sub`
Blake Stretton is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.