Tweak Macro to Save Each Page of Word Document as Separate PDF or Doc File?

Hewg74 · #1 08-22-2016, 10:33 AM

Hi guys,
I am new to the forum, and am new to the whole world of VBA. I found the code below online and its been extremely helpful, but I was wondering how to make some tweaks to it for different scenarios. It would help with learning how the variables interact as well. I've tried messing around with the code, but I can't seem to figure out how to properly structure out the syntax.

So the 3 things I would like to tweak are:

1. Instead of saving each page as a separate document, how do I get the code to save every 2 or 3 pages as a separate document.
2. Instead of exporting to PDF, how would you make it export as a word document.
3. For the naming convention, how would I pull the name from say, the 2nd line item in the Word Document (Client name) and save that as the title?

Many Thanks!

Code:

Option Explicit
Sub SaveAsSeparatePDFs()
 
Dim strDirectory As String, strTemp As String
Dim ipgStart As Integer, ipgEnd As Integer
Dim iPDFnum As Integer, i As Integer
Dim vMsg As Variant, bError As Boolean
 
1:
strDirectory = InputBox("Directory to save individual PDFs? " & _
    vbNewLine & "(ex: C:\Users\Public)")
If strDirectory = "" Then Exit Sub
If Dir(strDirectory, vbDirectory) = "" Then
    vMsg = MsgBox("Please enter a valid directory.", vbOKCancel, "Invalid Directory")
    If vMsg = 1 Then
        GoTo 1
    Else
        Exit Sub
    End If
End If
 
2:
strTemp = InputBox("Begin saving PDFs starting with page __? " & _
    vbNewLine & "(ex: 32)")
bError = bErrorF(strTemp)
If bError = True Then GoTo 2
ipgStart = CInt(strTemp)
 
3:
strTemp = InputBox("Save PDFs until page __?" & vbNewLine & "(ex: 37)")
bError = bErrorF(strTemp)
If bError = True Then GoTo 3
ipgEnd = CInt(strTemp)
 
iPDFnum = ipgStart
On Error GoTo 4:
For i = ipgStart To ipgEnd
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        strDirectory & "\Page_" & iPDFnum & ".pdf", ExportFormat:=wdExportFormatPDF, _
        OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
        wdExportFromTo, From:=i, To:=i, Item:=wdExportDocumentContent, _
        IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
        wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False
    iPDFnum = iPDFnum + 1
Next i
End
4:
vMsg = MsgBox("Unknown error encountered while creating PDFs." & vbNewLine & vbNewLine & _
    "Aborting", vbCritical, "Error Encountered")
End Sub
 
Private Function bErrorF(strTemp As String) As Boolean
Dim i As Integer, vMsg As Variant
bErrorF = False
 
If strTemp = "" Then
    End
ElseIf IsNumeric(strTemp) = True Then
    i = CInt(strTemp)
    If i > ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) Or i <= 0 Then
        Call msgS(bErrorF)
    End If
Else
    Call msgS(bErrorF)
End If
End Function
 
Private Sub msgS(bMsg As Boolean)
Dim vMsg As Variant
    vMsg = MsgBox("Please enter a valid integer." & vbNewLine & vbNewLine & _
        "Integer must be > 0 and < total pages in the document (" & _
        ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) & ")", vbOKCancel, "Invalid Integer")
    If vMsg = 1 Then
        bMsg = True
    Else
        End
    End If
End Sub

Also, with the tweaks done, they could all be separate and silo'ed tweaks. I am just wondering how to accomplish those tasks, they don't necessarily need to be within the same new code.

macropod · #2 08-22-2016, 03:12 PM

This kind of thing is usually reserved for splitting documents produced by a mailmerge. Accordingly, you might have a look at Send Mailmerge Output to Individual Files and Split Merged Output to Separate Documents in the Mailmerge Tips and Tricks 'sticky' thread, at: https://www.msofficeforums.com/mail-...ps-tricks.html

Hewg74 · #3 08-22-2016, 03:16 PM

Thank you! I'm reading the sticky but it's flying right over my head. How would you begin to tackle this problem?

macropod · #4 08-22-2016, 05:20 PM

I'd run whichever of the two macros best meets my needs. They're basically ready to run as-is. At most you might need to make the few changes indicated in the comments.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Auto Save Every Page(s) as a separate file, and name each new file automatically by the first line?	commissarmo	Word VBA	3	03-14-2015 12:53 AM
Help tweak the Macro	streetcat	Word VBA	3	01-27-2015 05:44 AM
Macro to create new word doc and save the file using String found in the document	VBNation	Word VBA	2	02-08-2013 07:14 AM
Word Macro: Save file as text with current file name	jabberwocky12	Word VBA	2	10-22-2010 12:23 PM
Any easy way to separate a Word document into separate files?	SamHelm	Word	0	08-21-2010 05:29 AM