Call Us At: 701.866.2098

Automate Significant Changes to PDF Documents with Actions and Macros


Date:Posted By:Comments:1 CommentCategory:<Coding with Coffee/>, Acro JavaScript, Troubleshooting with Trav, Visual BasicTag:, , , , , , , , , , , , ,

Software Needed: Adobe Acrobat DC, Microsoft Word

Tasked with making multiple changes to PDF documentation, I decided to automate the system rather then going through each document to update/save accordingly.

Essentially I was given 163 PDFs that required updates to verbiage and date periods, as well as the replacement of the last two pages of each document. Each date period needed to be saved as a separate file, so this meant of the 163 files I was given, 1141 files needed to be generated. This would be a daunting task without automation and frankly, who has the time? So, here’s how I made my PC work for me.

To begin, I created an action in Adobe Acrobat DC to run through the directory storing all of my PDFs. The action effectively would run through all the PDFs, deleting the last two pages of the document, export to Microsoft Word, then save. This would give me the Word documents needed for the Macros to make the changes later.

Adobe Acrobat Action Export to Word

Here’s the Acro-JavaScript used to remove the last two pages of all of the documents within the PDF Directory as shown in the action above:

/* remove last 2 pages */

this.deletePages({nStart: this.numPages-2, nEnd: this.numPages-1});

Here’s a screenshot of the save action used to export the PDF to Microsoft Word:
Export to Word from Acrobat Action

After running the action in Adobe Acrobat to generate the Word documents, I used a few Macros in Word to make the verbiage and date updates. I began with the verbiage updates, as all documents required this change. The following Macro1 was created for this update.

Sub Macro1()
'
' Macro1 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "formulary-2018"
        .Replacement.Text = "formulary-2019"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "formulary-2018"
        .Replacement.Text = "formulary-2019"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "if you need mental"
        .Replacement.Text = "if you need mental"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    With Selection
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.TypeText Text:="Precertification may be required."
    ActiveDocument.Save
        
End Sub

In addition to the script above, I needed an additional Macro to run through all the Word documents within the directory to call Macro1 for the verbiage updates:

Sub RUNTHROUGH()
Dim file
Dim path As String

path = "C:\Users\Travbot\Desktop\PDF Directory\"

file = Dir(path & "*.docx")
Do While file <> ""
Documents.Open FileName:=path & file

Call Macro1

ActiveDocument.Save
ActiveDocument.Close
file = Dir()
Loop
End Sub

After running the RUNTHROUGH Macro for the verbiage updates, I was ready to create the Macros to make the date updates. For each of the following scripts, I used used the RUNTHROUGH script to call all of these scripts individually, then used a command in Powershell to rename each batch as I ran the Macro in Word.

Notice, Each of the following Macro’s makes the necessary changes, saves, then exports the document to PDF.

Sub MacroDATE1()
'
' MacroDATE1 Macro
'
'
Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "What You Pay For Covered Services" & vbTab
        .Replacement.Text = "What You Pay For Covered Services "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Coverage Period:"
        .Replacement.Text = _
            "          Coverage Period: 01/01/2019 - 12/31/2019 "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Coverage Period: 01/01/2019 - 12/31/2019 "
        .Replacement.Text = "    Coverage Period: 01/01/2019 - 12/31/2019 "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Coverage Period: 01/01/2019 - 12/31/2019 "
        .Replacement.Text = "    Coverage Period: 01/01/2019 - 12/31/2019 "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Coverage Period: 01/01/2019 - 12/31/2019 "
        .Replacement.Text = "  Coverage Period: 01/01/2019 - 12/31/2019 "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveDocument.Save
        ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        Replace(ActiveDocument.FullName, ".docx", ".pdf"), ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub

Sub MacroDATE2()
'
' MacroDATE2 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Coverage Period: 01/01/2019 - 12/31/2019 "
        .Replacement.Text = "Coverage Period: 02/01/2019 - 01/31/2020 "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveDocument.Save
        ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        Replace(ActiveDocument.FullName, ".docx", ".pdf"), ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub

Sub MacroDATE3()
'
' MacroDATE3 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Coverage Period: 02/01/2019 - 01/31/2020 "
        .Replacement.Text = "Coverage Period: 03/01/2019 - 02/29/2020 "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveDocument.Save
        ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        Replace(ActiveDocument.FullName, ".docx", ".pdf"), ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub

Sub MacroDATE4()
'
' MacroDATE4 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Coverage Period: 03/01/2019 - 02/29/2020 "
        .Replacement.Text = "Coverage Period: 04/01/2019 - 03/31/2020 "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveDocument.Save
        ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        Replace(ActiveDocument.FullName, ".docx", ".pdf"), ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub

Sub MacroDATE5()
'
' MacroDATE5 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Coverage Period: 04/01/2019 - 03/31/2020 "
        .Replacement.Text = "Coverage Period: 05/01/2019 - 04/30/2020 "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveDocument.Save
        ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        Replace(ActiveDocument.FullName, ".docx", ".pdf"), ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub

Sub MacroDATE6()
'
' MacroDATE6 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Coverage Period: 05/01/2019 - 04/30/2020 "
        .Replacement.Text = "Coverage Period: 06/01/2019 - 05/31/2020 "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveDocument.Save
        ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        Replace(ActiveDocument.FullName, ".docx", ".pdf"), ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub

Here’s the Powershell command used to change the file names as each batch was produced:

get-childitem *.pdf | foreach { rename-item $_ $_.Name.Replace("WORD/PHRASE TO REPLACE", "REPLACEMENT WORD/PHRASE") }

The last item was to create an action to add the two new pages to the end of each of the new PDFs. For this, another action was created in Adobe Acrobat.

Add Pages Acrobat Action

1 Comment

  1. furtdso linopv

    Reply

    Good day! I just would like to give an enormous thumbs up for the good information you might have right here on this post. I can be coming again to your weblog for extra soon.

Leave a comment

Your email address will not be published. Required fields are marked *