Save as PDF - How to add extra functionality to split by page break

[amlong]

The code you posted at https://www.msofficeforums.com/word-...html#post18401 works perfectly, but can it be enhanced to split the word mail merge by page break and save each individual file to pdf?



Any assistance you could give would be appreciated.

Thanks
A

Sub SaveToPDF()
Dim StrPath As String, StrName As String, Result
With ActiveDocument
  On Error GoTo Errhandler
  StrPath = GetFolder & "\"
  StrName = Split(.Name, ".")(0)
  While Dir(StrPath & StrName & ".pdf") <> ""
    Result = InputBox("WARNING - A file already exists with the name:" & vbCr & _
      Split(.Name, ".")(0) & vbCr & _
      "You may edit the filename or continue without editing." _
      & vbCr & vbTab & vbTab & vbTab & "Proceed?", "File Exists", StrName)
    If Result = vbCancel Then Exit Sub
    If StrName = Result Then GoTo Overwrite
    StrName = Result
  Wend
Overwrite:
  .ExportAsFixedFormat OutputFileName:=StrPath & StrName & ".pdf", _
  ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
  OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
  Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
  CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
  BitmapMissingFonts:=True, UseISO19005_1:=False
End With
Errhandler:
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function