Save every page as a separate PDF with names?
Hi!
I just wanted to say before that I would like to thank you for helping people like me who are still amateurs and need help in this stuff. You have no idea how much help you are.
So the thing if that our company generates reports. Many are generated into 1 big word file. The only difference is the company we are sending it to. Part of my job is to generate a pdf file from every page and name it corrently with the adress. For exmaple: I get a 63 page word file. every page is almost the same but the adress and the recipient is different. As you can guess doing this manually is a lot of Work.
I recentyl found somebody online who created a macro that basically creates a PDF out fo each page individually and it works perfectly. This kind of macro is way more complex than what I could currentyl figure out so here is where I need you guys' insights.
We need to change the code a bit. So that when it creates a PDF out of a page it names it correctly. So for example if it finds "John Smiths" on the page then it names it "John_Smiths". I had an Idea to have a separate excel file for this to make it furute proof. Maybe to have an A column and a B column. A contains the stuff it should find in the file and B what it should name it to. So if A1 contains "John Smith" the it then it names the page by B1 which is "John_Smith". This is so we can add recipients later. I'll include the current code and the page I found it in. How should we solve this?
I found the code here:
https://wellsr.com/vba/2015/word/exa...separate-pdfs/
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
Thanks you for all your help!
