Publisher VBA转换为MailMerge

Question

我有包含MailMerge记录的Publisher文档。我的目标是将每一页的每条记录转换成单独的PDF文档。

我已经写了这段代码。它生成具有正确名称的PDF文件，但由于某种原因，PDF仅包含来自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

我想它需要一点改变，一切都会很好，但我找不到解决方案。

Answer 1

我也遇到过同样的问题。我已经想出了一个粗略的解决办法，但它对我来说是有效的。

其主要思想是创建一个新的“.pub”文件，并以该文件为目标执行MailMerge。在此之后，可以根据初始文档的页码导出单独的PDF。

我在合并大文件时遇到了一些问题。这就是我构建睡眠函数的原因(基于这个线程：There is no Wait Method associated with Application in VisualBasic Word)

希望它能帮上忙！

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