Microsoft Office Forums - View Single Post - Split word file into several PDF using the bookmarks as split positions and name

gmayor · 10-05-2018, 06:01 AM

That's what happens when you only have half the required information to work with.

You will need to create a temporary document based on the original if you want the headers and footers. The path issue is addressed and the naming issue should be, thus the following will get you closer, but without access to the original document it is still based on guesswork.

There should be no bookmark at the end of the original document and no manual or section page breaks in that document.

If the document is the result of a mail merge use http://www.gmayor.com/MergeAndSplit.htm instead

Code:

Sub Splitter2()
' 'Graham Mayor - http://www.gmayor.com - Last updated - 05 Oct 2018
' to split a document to separate PDF files by bookmarks
Dim strMask As String
Dim lngDocs As Long
Dim lngCount As Long
Dim strName As String
Dim oDoc As Document
Dim oTempDoc As Document
Dim oRng As Range
Dim strPath As String

    Set oDoc = ActiveDocument
    oDoc.Save
    strPath = oDoc.path & "\"
    lngDocs = oDoc.Bookmarks.Count + 1
    lngCount = 1
    While lngCount <= lngDocs
        Set oRng = oDoc.Range
        If lngCount < lngDocs Then
            oRng.End = oDoc.Bookmarks(1).Range.End
            strMask = oDoc.Bookmarks(1).Name
            oDoc.Bookmarks(1).Delete
        End If

        Set oTempDoc = Documents.Add(oDoc.FullName)
        oTempDoc.Range.FormattedText = oRng.FormattedText

        strName = strMask & " " & LTrim$(Str$(lngCount)) & ".pdf"
        oTempDoc.ExportAsFixedFormat _
                OutputFileName:=strPath & strName, _
                ExportFormat:=wdExportFormatPDF, _
                OptimizeFor:=wdExportOptimizeForPrint, _
                CreateBookmarks:=wdExportCreateWordBookmarks, _
                DocStructureTags:=True, _
                BitmapMissingFonts:=True
        lngCount = lngCount + 1
        oRng.Text = ""
        oTempDoc.Close wdDoNotSaveChanges
    Wend
    oDoc.Close wdDoNotSaveChanges
End Sub