Microsoft Office Forums - View Single Post - [Solved] Tweak Macro to Save Each Page of Word Document as Separate PDF or Doc File?

Hewg74 · 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.