Consulting

Results 1 to 9 of 9

Thread: Save every page as a separate PDF with names?

  1. #1

    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/

    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!

  2. #2
    Hey! I realised that we don't need the excel file since the recipient is always in the 4th row. every page begins with 3 "paragraph ends" (the thing that happens when you press "Enter" in word) and the recipient is in the 4th row. So the only thing we need is tell excel that use the 4th row as name not the following code:

    iPDFnum = ipgStartOn 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
    Last edited by CaptainCsaba; 03-25-2018 at 11:45 PM.

  3. #3
    Hey! Does someone know how to solve this? Is there a command that says "use the 4th paragraph for the file name" for that 1 line?

  4. #4
    How are the pages separated? If they are separated by section breaks see http://www.gmayor.com/MergeAndSplit.htm

    If they are manual page breaks then use the macro below to convert them to section breaks first.

    Sub ReplacePageBreaks()
    Dim orng As Range
        Set orng = ActiveDocument.Range
        With orng.Find
            Do While .Execute(FindText:="^m")
                orng.Select
                orng.Text = ""
                orng.InsertBreak wdSectionBreakNextPage
            Loop
        End With
    lbl_Exit:
        Set orng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Hey gmayor!
    Thanks but there is a section break at the end of every page. Since then I realised that the paragraph ends vary each time between 2 and 4. So every page begins with 2-4 paragraph ends and only then is the recipient name. I don't think they are necessary so we could put a line into the macro to delete all the paragraph ends until it reaches text and then use the first paragraph as file name.

  6. #6
    Okay I wrote a code to delete the empty paragraphs in the begining of every page. So now we only have to tell it that it should name it after the first paragraph.
    What should I write instead of this?

    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    strDirectory & "\Page_" & iPDFnum & ".pdf"

  7. #7
    If each page is a separate section, the add-in I linked earlier would save re-inventing the wheel, however the following should work with provisos. Duplicate names will be overwritten (you will find code on my web site to allow the creation of unique names). The macro also makes no allowance for excessively long filenames or missng filenames

    Option Explicit
    
    Sub Macro1()
    Dim oSection As Section
    Dim strName As String
    Dim strDirectory As String
    Dim oRng As Range
    Dim vMsg As Long
        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 = 0 Then Exit Sub
        End If
        For Each oSection In ActiveDocument.Sections
            On Error GoTo lbl_Exit
            Set oRng = oSection.Range.Paragraphs(1).Range
            oRng.End = oRng.End - 1
            strName = oRng.Text & ".pdf"
            strName = CleanFileName(strName, "pdf")
            oSection.Range.Select
            ActiveDocument.ExportAsFixedFormat OutputFileName:=strDirectory & "\" & strName, ExportFormat:=wdFormatPDF, Range:=wdExportCurrentPage
        Next oSection
    lbl_Exit:
        Exit Sub
        Set oSection = Nothing
        Set oRng = Nothing
    End Sub
    
    Private Function CleanFileName(strFilename As String, strExtension As String) As String
    'Graham Mayor
    'A function to ensure there are no illegal filename
    'characters in a string to be used as a filename
    'strFilename is the filename to check
    'strExtension is the extension of the file
    Dim arrInvalid() As String
    Dim vfName As Variant
    Dim lng_Name As Long
    Dim lng_Ext As Long
    Dim lng_Index As Long
        'Ensure there is no period included with the extension
        strExtension = Replace(strExtension, Chr(46), "")
        'Record the length of the extension
        lng_Ext = Len(strExtension)
    
        'Remove the path from the filename if present
        If InStr(1, strFilename, Chr(92)) > 0 Then
            vfName = Split(strFilename, Chr(92))
            CleanFileName = vfName(UBound(vfName))
        Else
            CleanFileName = strFilename
        End If
    
        'Remove the extension from the filename if present
        If Right(CleanFileName, lng_Ext + 1) = "." & strExtension Then
            CleanFileName = Left(CleanFileName, InStrRev(CleanFileName, Chr(46)) - 1)
        End If
    
        'Define illegal characters (by ASCII CharNum)
        arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
        'Add the extension to the filename
        CleanFileName = CleanFileName & Chr(46) & strExtension
        'Remove any illegal filename characters
        For lng_Index = 0 To UBound(arrInvalid)
            CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lng_Index)), Chr(95))
        Next lng_Index
    lbl_Exit:
        Exit Function
    End Function
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  8. #8
    Wow! It works perfectly! It is amazing how much you have helped our team. Thank you!

  9. #9
    Bonjour à tous,
    Je viens de m'inscrire et je demande votre aide.
    J'ai un code qui me permet d'enregistrer les documents word microsoft en pdf séparément mais à la place de "I" je voudrai avec des noms qui sont dans le paragraphe 18.

    Voici le code:


    Sub SaveAsSeparatePDFs ()
    'Updated by Extendoffice 20180906
    Dim I As Long
    Dim xStr As String
    Dim xPathStr As Variant
    Dim xDictoryStr As String
    Dim xFileDlg As FileDialog
    Dim xStartPage, xEndPage As Long
    Dim xStartPageStr, xEndPageStr As String
    Set xFileDlg = Application.FileDialog
    -1 ensuite
    MsgBox "Veuillez choisir un répertoire valide", vbInformation, "Kutools for Word"
    Quitter Sub
    End If
    xPathStr = xFileDlg.SelectedItems (1)
    xStartPageStr = InputBox ("Commencer à enregistrer les PDF à partir de la page __?" & VbNewLine & "(ex: 1 ) "," Kutools for Word ")
    xEndPageStr = InputBox (" Enregistrer les PDF jusqu'à la page __? "& VbNewLine &" (ex: 7) "," Kutools for Word ")
    Sinon (IsNumeric (xStartPageStr) Et IsNumeric (xEndPageStr) ) Puis
    MsgBox "La page de démarrage et la page de fin doivent être au format numérique", vbInformation, "Kutools for Word"
    Quitter Sub
    End Si
    xStartPage = CInt (xStartPageStr)
    xEndPage = CInt (xEndPageStr)
    Si xStartPage> xEndPage Then
    MsgBox "Le numéro de page de démarrage ne peut pas être plus grand que la page de fin", vbInformation, "Kutools pour Word"
    Exit Sub
    End If
    Si xEndPage> ActiveDocument.BuiltInDocumentProperties (wdPropertyPages) Alors
    xEndPage = ActiveDocument.BuiltInDocumentProperties (wdPropertyPages)
    End If
    For I = Pour xStartPage xEndPage
    ActiveDocument.ExportAsFixedFormat xPathStr & "\ page_" & I & ".pdf", _
    wdExportFormatPDF, Faux, wdExportOptimizeForPrint, wdExportFromTo, I, I, wdExportDocumentWithMarkup, _
    Faux, faux, wdExportCreateHeadingBookmarks, True, False, False
    Next
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •