View Single Post
 
Old 10-05-2018, 10:07 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,142
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Your sample document does not match the criteria required by the macro(s) I posted.

You have the bookmarks at the starts of the segments and not at the ends, and you have a column break(?) to separate each page, which was completely unexpected. To deal with that sort of layout you need a different approach.

Provided your actual document reflects the sample, the following will work. The sample creates four PDF files named with the bookmark names in the same folder as the document.

Code:
Sub Splitter3()
' 'Graham Mayor - http://www.gmayor.com - Last updated - 06 Oct 2018
' to split example document to separate PDF files
Dim strName As String
Dim oDoc As Document
Dim oTempDoc As Document
Dim oRng As Range, oPage As Range
Dim strPath As String

    Set oDoc = ActiveDocument
    oDoc.Save
    strPath = oDoc.path & "\"
    Set oPage = oDoc.Range
    With oPage.Find
        Do While .Execute(FindText:="^n")
            Set oRng = oDoc.Range
            oRng.End = oPage.End
            oPage.Text = ""
            Set oTempDoc = Documents.Add(oDoc.FullName)
            oTempDoc.Range.FormattedText = oRng.FormattedText

            strName = oTempDoc.Bookmarks(1).Name & ".pdf"
            oTempDoc.ExportAsFixedFormat _
                    OutputFileName:=strPath & strName, _
                    ExportFormat:=wdExportFormatPDF, _
                    OptimizeFor:=wdExportOptimizeForPrint, _
                    CreateBookmarks:=wdExportCreateWordBookmarks, _
                    DocStructureTags:=True, _
                    BitmapMissingFonts:=True
            oRng.Text = ""
            oTempDoc.Close wdDoNotSaveChanges
        Loop
    End With
    strName = oDoc.Bookmarks(1).Name & ".pdf"
    oDoc.ExportAsFixedFormat _
            OutputFileName:=strPath & strName, _
            ExportFormat:=wdExportFormatPDF, _
            OptimizeFor:=wdExportOptimizeForPrint, _
            CreateBookmarks:=wdExportCreateWordBookmarks, _
            DocStructureTags:=True, _
            BitmapMissingFonts:=True
    oDoc.Close wdDoNotSaveChanges
lbl_Exit:
    Set oDoc = Nothing
    Set oTempDoc = Nothing
    Set oRng = Nothing
    Set oPage = Nothing
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote