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

[macropod]

Yes, that's possible, but it would require a fair bit of re-working and how would each PDF be named?

PS: I moved your initial post to a new thread.

[amlong]

Hi Paul

The first line of each merge (after the header data) has the naming convention for the letters that comprise of a few merge fields put together + .pdf. The first lines will look something like this:

2619.T138.09.20.12.pdf
2619.MHRPD.09.20.12.pdf


2619.9110.09.20.12.pdf


I will prepare a washed sample file and attach.

Thanks
Andrea

[amlong]

Hi

Here is a sample of the mail merge document.

Thanks
Andrea

[macropod]

Hi Andrea,

Since you're proposing to use this with mailmerge, I suggest you take a look at: http://www.gmayor.com/individual_merge_letters.htm

[amlong]

Originally Posted by macropod

Hi Andrea,

Since you're proposing to use this with mailmerge, I suggest you take a look at: http://www.gmayor.com/individual_merge_letters.htm

Unfortunately, the company i work for will not allow the addin

[macropod]

Hi Andrea,

Try:

Sub ExportPagesToPDF()
Dim StrPath As String, StrName As String, Rng As Range
StrPath = GetFolder & "\"
With ActiveDocument
  Set Rng = .Range(0, 0)
  With .Range
    With .Characters.Last
      While .Previous Like "[" & Chr(9) & "-" & Chr(14) & Chr(32) & Chr(160) & "]"
        .Previous.Text = vbNullString
      Wend
    End With
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = Chr(12)
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Execute
    End With
    Do While .Find.Found
      Rng.End = .End
      StrName = Split(Split(Rng.Text, vbCr)(0), " ")(0)
      With Rng.Characters
        Call SavePDF(ActiveDocument, StrPath, StrName, .First.Information(wdActiveEndPageNumber), .Last.Information(wdActiveEndPageNumber))
      End With
      Rng.Collapse wdCollapseEnd
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
  Rng.End = .Range.End
  StrName = Split(Split(Rng.Text, vbCr)(0), " ")(0)
  With Rng.Characters
    Call SavePDF(ActiveDocument, StrPath, StrName, .First.Information(wdActiveEndPageNumber), .Last.Information(wdActiveEndPageNumber))
  End With
End With
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
 
Sub SavePDF(Doc As Document, StrPath As String, StrName As String, StartPage As Long, EndPage As Long)
Dim Result As String
On Error GoTo Errhandler
While Dir(StrPath & StrName) <> ""
  Result = InputBox("WARNING - A file already exists with the name:" & vbCr & _
    StrName & vbCr & _
    "You may edit the filename or continue without editing." _
    & vbCr & vbTab & vbTab & vbTab & "Proceed?", "File Exists", StrName)
  If Result = "" Then Exit Sub
  If StrName = Result Then GoTo Overwrite
  StrName = Result
Wend
Overwrite:
Doc.ExportAsFixedFormat OutputFileName:=StrPath & StrName, UseISO19005_1:=False, _
  ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
  OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportFromTo, _
  From:=StartPage, To:=EndPage, Item:=wdExportDocumentContent, _
  IncludeDocProps:=True, CreateBookmarks:=wdExportCreateNoBookmarks, _
  KeepIRM:=True, DocStructureTags:=True, BitmapMissingFonts:=True
  Exit Sub
Errhandler:
  MsgBox "Error processing: " & StrName, vbExclamation
End Sub

So far as the code is concerned, it doesn't matter whether manual page breaks or Section breaks are used to delineate the reports; just don't use, say, continuous Section breaks within a report or it will get split.

[amlong]

Paul

I have never seen a more beautiful thing in all my life.

<3


you should add this to that mail merge tutorial doc. it is very useful.

Andrea