Split word file into several PDF using the bookmarks as split positions and name

Fixxxer · #1 10-05-2018, 01:35 AM

Hello all and thank you for the help.

I work daily with several word documents that I later save as pdf. I used information to modify a vba macro to directly save to pdf keeping the bookmark structure. This is already a great help, but now I want to take it to the next level:

have a vba that will automatically create several pdfs from the one word file, split at the bookmark point and also adding the bookmark name. Something like "myfile_bookrmakname.pdf".

thank you in advance for all the help.

Below is the code I am using.

PHP Code:


			
Sub Save_As_PDF()

'

' Save_As_PDF Macro

'

'



 Dim sName As String

    Dim sPath As String



    With ActiveDocument

        sName = Left(.Name, InStr(.Name, ".") - 1)

        sName = sName & ".pdf"

        sPath = .Path & "\"



        .ExportAsFixedFormat _

          OutputFileName:=sPath & sName, _

          ExportFormat:=wdExportFormatPDF, _

          OptimizeFor:=wdExportOptimizeForPrint, _

          CreateBookmarks:=wdExportCreateWordBookmarks, _

          DocStructureTags:=True, _








          BitmapMissingFonts:=True

    End With





End Sub

gmayor · #2 10-05-2018, 04:48 AM

Loosely based on http://www.gmayor.com/individual_merge_letters.htm, try the following, which assumes that the bookmarks mark the ends of the files and that there is no bookmark at the end or the start of the document.

Change the value of strPath to a folder that exists,

Code:

Sub Splitter()
' '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 oRng As Range

Const strPath As String = "E:\Path\Forum\Backup\"
    Set oDoc = ActiveDocument
    oDoc.Save
    lngDocs = oDoc.Bookmarks.Count + 1
    strMask = "ddMMyy"
    lngCount = 1
    While lngCount <= lngDocs
        Set oRng = oDoc.Range
        If lngCount < lngDocs Then
            oRng.End = oDoc.Bookmarks(1).Range.End
            oDoc.Bookmarks(1).Delete
        End If

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

Fixxxer · #3 10-05-2018, 05:23 AM

Thank you!

I tried using Const strPath As String = "\" to make it use the current path, but it did not like it. I would like to be able to just use the current folder where the docx is - most are on a network location. I moved the test file to "C:\test\" and it worked.

I moved the bookmarks to the end of the each page and the macro did split the file in multiple pdfs, but header and footer where missing, and I got one blank page before each page.
I have 4 bookmarks and got 5 files. the last one was the one containing the header and footer.

Finally, the files are named "051018 1", "051018 2" etc, instead of using the bookmark name.

gmayor · #4 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

Fixxxer · #5 10-05-2018, 06:22 AM

Don't get me wrong, I am not complaining.
This version is much closer. Headers and footers are fine!

The pdfs are using the bookmark name, but there is an extra counter that is not necessary. eg "bookmarkA 1", "bookmarkB 2"...

Also, the positions of the bookmarks is mixed up when exporting to pdfs. Also, I still have 4 bookmarks, but get 5 files.

Do I need to move the bookmark positions within the page I need to split?
Are section breaks allowed?

gmayor · #6 10-05-2018, 10:07 PM

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

Fixxxer · #7 10-07-2018, 10:56 PM

Sir, you are a lifesaver! Thank you!

your macro indeed works for smaller files, like the one I attached, but on larger files, like the ones I usually work with (20-80 pages), it does not. it starts doing something, but then just stops and quits the original word file.

I narrowed it down to the existence of page breaks or column breaks. If I use page breaks, then the above macro does not work correctly. If I use column breaks, it works like a charm!

gmayor · #8 10-08-2018, 01:10 AM

The macro splits by column breaks as in your sample (FindText:="^n") If you want to split by manual page breaks use ^m instead or section breaks ^s

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Word VBA - Split Document By Headings - Save File Name As Heading Name	jc491	Word VBA	7	01-21-2022 11:04 AM
split word document based on bookmarks with each new document title of the bookmark	megatronixs	Word VBA	9	09-05-2020 02:29 PM
Split function in Excel (split the screen)	Officer_Bierschnitt	Excel	1	07-05-2017 07:02 AM
Programmatically split a rtf word file without opening	Esgrimidor	Word VBA	8	03-29-2017 11:15 AM