Publisher VBA MailMerge - Converting to PDF - vba

Question

I have Publisher document with MailMerge records. My goal is to convert each page with each record to separate PDF document.
I have written this code. It generates PDF files with correct names, but for some reason PDFs contain only the second record from MailMerge.
Sub MailMerge()
Dim Lot As MailMergeDataField
Dim Price As MailMergeDataField
Dim Street As MailMergeDataField
Dim i As Long
Dim MainDoc As Document
Set MainDoc = ActiveDocument
With MainDoc
For i = 1 To .MailMerge.DataSource.RecordCount
With .MailMerge
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
Set Lot = .DataFields.Item("Lot")
Set Price = .DataFields.Item("Price")
Set Street = .DataFields.Item("Street")
ThisDocument.ExportAsFixedFormat pbFixedFormatTypePDF, Lot.Value & "-" & Street.Value & ".pdf"
End With
.Execute Pause:=False, Destination:=pbMergeToNewPublication
End With
Next i
End With
End Sub
I guess it needs a little change and everything will work fine, but I can't find out the solution.

Answer 1

I've stumbled into the same problem. I've came up with a sketchy workaround, but it works for me.
The main idea is to create a new '.pub'-file and perform the MailMerge with this file as the destination. After this, it is possible to export the separate PDF's, based on the page numbers from the initial document.
I had some problems with merging large files. That's why I built in the sleep function (based on this thread: There is no Wait Method associated with Application in VisualBasic Word)
Hopefully it helps!
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Sub Export_to_seperate_PDFs()
' Variables for MailMerge
Dim naam As MailMergeDataField
Dim i As Long
' Variables for This Document
Dim MainDoc As Document
Dim PathName As String
Dim FileName As String
Set MainDoc = ActiveDocument
PathName = MainDoc.Path
FileName = MainDoc.Name
Npages = MainDoc.Pages.Count
Debug.Print Npages
' Make a new Document called empty.pub in the same directory
Dim NewAppPub As New Publisher.Application
Set AppPub = New Publisher.Application
Set DocPub = AppPub.NewDocument
AppPub.ActiveWindow.Visible = True
DocPub.SaveAs FileName:=PathName & "empty.pub"
AppPub.ActiveDocument.Close
' Perform MailMerge
MainDoc.MailMerge.Execute Pause:=False, Destination:=3, _
FileName:=PathName & "empty.pub"
' try to close any other open publications (this does not seem to work yet)
Dim objDocument As Document
For Each objDocument In Documents
Debug.Print objDocument.Name
If objDocument.Name = "empty.pub" Then
objDocument.SaveAs FileName:=PathName & "empty.pub"
objDocument.Close
ElseIf Not objDocument.Name = FileName Then
objDocument.Close
End If
Next objDocument
' Let the application wait for a couple of seconds
' in order to prevent errors on opening large files
Sleep 15000
NewAppPub.Open FileName:=PathName & "empty.pub"
' Loop through the records and save seperate PDFs'
With MainDoc
For i = 1 To .MailMerge.DataSource.RecordCount
With .MailMerge
.SuppressBlankLines = False
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
Set naam = .DataFields.Item("Name")
Debug.Print naam.Value
' Export publication to PDF based on page numbers
NewAppPub.ActiveDocument.ExportAsFixedFormat pbFixedFormatTypePDF, _
PathName & naam.Value & ".pdf", _
From:=((i - 1) * Npages) + 2, _
To:=i * Npages + 1
End With
End With
Next i
End With
End Sub