VBA, Acrobat Pro Add Header&Footer to Pdf

Question

I use acrobat xi pro with vba to combine my pdf files.

I have a code which appends pdf pages together using acrobat api found here: https://wwwimages2.adobe.com/content/dam/acom/en/devnet/acrobat/pdfs/iac_api_reference.pdf

However I am trying to automatically number the pages, or add my custom saved header and footer settings and apply to all pages.

Here is my code:

   Dim acroExchangeApp As Object
    Set app = CreateObject("Acroexch.app")

    Dim filePaths As Collection     'Paths for PDFS to append
    Set filePaths = New Collection
    Dim fileRows As Collection      'Row numbers PDFs to append
    Set fileRows = New Collection
    Dim sourceDoc As Object
    Dim primaryDoc As Object        ' PrimaryDoc is what we append too
    Dim insertPoint As Long         ' PDFs will be appended after this page in the primary Doc
    Dim startPage As Long           ' First desired page of appended PDF
    Dim endPage As Long             ' Last desired page of appended PDF
    Dim colIndex As Long            '
    Dim numPages As Long
    Dim acroDoc As Object
    Set acroDoc = New AcroPDDoc


    Set primaryDoc = CreateObject("AcroExch.PDDoc")
    OK = primaryDoc.Open(filePaths(1))
    Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK

    For colIndex = 2 To filePaths.count
        query_start_time = time()
        start_memory = GetWorkingMemoryUsage

        numPages = primaryDoc.GetNumPages() - 1

        Set sourceDoc = CreateObject("AcroExch.PDDoc")
        OK = sourceDoc.Open(filePaths(colIndex))
        Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK


     numberOfPagesToInsert = sourceDoc.GetNumPages

        'inserts pages
        acroDoc.Open source_file_name

        insertPoint = acroDoc.GetNumPages - 1


        If endPage > 1 Then
            OK = primaryDoc.InsertPages(insertPoint, sourceDoc, startPage, endPage - startPage, False)
            Debug.Print "(" & colIndex & ") " & endPage - startPage & " PAGES INSERTED SUCCESSFULLY: " & OK
        Else
            OK = primaryDoc.InsertPages(insertPoint, sourceDoc, startPage, endPage - startPage + 1, False)
            Debug.Print "(" & colIndex & ") " & endPage - startPage + 1 & " PAGES INSERTED SUCCESSFULLY: " & OK
        End If


           Set sourceDoc = Nothing

    Next colIndex

    OK = primaryDoc.Save(PDSaveFull, filePaths(1))
    Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK

    Set primaryDoc = Nothing
    app.Exit
    Set app = Nothing

Can anyone help with this?

@HackSlash Sorry, can you help me automatically insert a footer into each pdf? — excelguy, Dec 07 '18 at 02:30
From doing some quick online research, there doesn't appear to be a method in Acrobat's API that will do this. However, there does appear to be a [possible workaround](https://stackoverflow.com/q/29085466/5781745) if you want to see if that helps any. — K.Dᴀᴠɪs, Dec 12 '18 at 07:36
is it possible to access headers and footers directly using acrobat pro in vba, as I note that the output is not in the footer itself. I mean with no workaround. — YasserKhalil, Jul 14 '23 at 06:44

GoodJuJu · Accepted Answer · 2018-12-12T22:03:53.260

Full credit goes to @NiH for his post on SO Adding page numbers to pdf through VBA and Acrobat IAC

I have modified your code below to include his using the JavaScript Object:

Modification inside:

'************************************************************* '*************************************************************

Dim acroExchangeApp As Object
    Set app = CreateObject("Acroexch.app")

    Dim filePaths As Collection     'Paths for PDFS to append
    Set filePaths = New Collection
    Dim fileRows As Collection      'Row numbers PDFs to append
    Set fileRows = New Collection
    Dim sourceDoc As Object
    Dim primaryDoc As Object        ' PrimaryDoc is what we append too
    Dim insertPoint As Long         ' PDFs will be appended after this page in the primary Doc
    Dim startPage As Long           ' First desired page of appended PDF
    Dim endPage As Long             ' Last desired page of appended PDF
    Dim colIndex As Long            '
    Dim numPages As Long
    Dim acroDoc As Object
    Set acroDoc = New AcroPDDoc


    Set primaryDoc = CreateObject("AcroExch.PDDoc")
    OK = primaryDoc.Open(filePaths(1))
    Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK

    For colIndex = 2 To filePaths.count
        query_start_time = time()
        start_memory = GetWorkingMemoryUsage

        numPages = primaryDoc.GetNumPages() - 1

        Set sourceDoc = CreateObject("AcroExch.PDDoc")
        OK = sourceDoc.Open(filePaths(colIndex))
        Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK


     numberOfPagesToInsert = sourceDoc.GetNumPages

        'inserts pages
        acroDoc.Open source_file_name

        insertPoint = acroDoc.GetNumPages - 1

        If endPage > 1 Then
            OK = primaryDoc.InsertPages(insertPoint, sourceDoc, startPage, endPage - startPage, False)
            Debug.Print "(" & colIndex & ") " & endPage - startPage & " PAGES INSERTED SUCCESSFULLY: " & OK
        Else
            OK = primaryDoc.InsertPages(insertPoint, sourceDoc, startPage, endPage - startPage + 1, False)
            Debug.Print "(" & colIndex & ") " & endPage - startPage + 1 & " PAGES INSERTED SUCCESSFULLY: " & OK
        End If

           Set sourceDoc = Nothing

    Next colIndex

    OK = primaryDoc.Save(PDSaveFull, filePaths(1))

        '*************************************************************
        '*************************************************************
        Dim jso As Object

        Set jso = primaryDoc.GetJSObject


        'Write page numbers to all pages
        For i = 1 To primaryDoc.GetNumPages
            jso.addWatermarkFromText _
                cText:=Str(i) & "  ", _
                nTextAlign:=1, _
                nHorizAlign:=2, _
                nVertAlign:=4, _
                nStart:=i - 1, _
                nEnd:=i - 1
        Next i
        '*************************************************************
        '*************************************************************

    OK = primaryDoc.Save(PDSaveFull, filePaths(1))
    Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK

    Set primaryDoc = Nothing
    app.Exit
    Set app = Nothing

Hi, can you explain the `*`'s ? Are you saying this is the the part I need to add to my code? — excelguy, Dec 12 '18 at 15:14
Yes, everything within the '******. Although you should be able to just replace your code with the code I have above... — GoodJuJu, Dec 12 '18 at 15:15
Hey, thanks for this, but for some reason it only numbers the first 3 pages . Do you know why this could be? Also running this newly added code my pdf file size goes from 10k KB to 20k KB, for 3 page numbers! — excelguy, Dec 12 '18 at 17:23
ive tried replacing `numpagestoinsert` with `getnumpages` this works, but my pdf file is over 300k Kb., and is still missing 2 of the pages at the end. — excelguy, Dec 12 '18 at 17:32
I have modified my original answer and moved the 'Page Number Insertion' code to below the original 'Save' command (and repeated the save command after the code that was moved). This should allow the new, increased page count to be accessed. With regards to the file size increase, you have stumbled across a common issue. The fonts are being embedded which is causing the increase. You are also using PDSaveFull. There is a function called AVDocSaveOptimized. I'll take a look at what can be done to utilise it. — GoodJuJu, Dec 12 '18 at 22:16
Thanks! Looks like it works.. of course I need to adjust the size and text. If I want to do like "Page 1" , Page 2" etc, how do I add text? Also why do you repeat `OK = primaryDoc.Save(PDSaveFull, filePaths(1))` ? — excelguy, Dec 13 '18 at 01:38
To control the font size, you can add the line `nFontSize:=10, _` to your code. The first save is to write the pdf and therefore when PageCount is called it reflects the new page count, including the pages you inserted. You can comment out the first save and see if it still works as desired. If it does, then you can remove the first save. You can control the text by altering the line `cText:=Str(i) & " ", _` to somehting like `cText:="Page " & Str(i) & " of " & sourceDoc.GetNumPages, _` or `cText:="Page " & Str(i), _` — GoodJuJu, Dec 13 '18 at 07:37
Thank you. You have been very helpful. Only two small things, 1) file size is doubling, I can live with this, 2) In the future if I want to Bold the text, or shift the page number a tiny bit vertical and horizontal, how do I do that? Seems like when I change the `Nvert` and `NHorz` it is a dramatic shift in number placement. For example the placement right now is right on the corner of the page. — excelguy, Dec 13 '18 at 14:21

score 1 · Answer 2 · edited Feb 07 '20 at 19:51

I tried AddField and watermark.

AddField takes <2 sec (for a 13 page document) Watermark takes 20+ sec for the same document Change the middle part to:

For i = 0 To intPages - 1
    Set objTextfeld = jso.AddField("Textfeld" & i, "text", i, Array(250, 50, 300, 0))
    objTextfeld.Value = "--" & Str(i + 1) & " --"
    objTextfeld.textSize = 10
    objTextfeld.textFont = "Calibri"
Next i

Here comes the full code:

Sub addPageNumbers(sFile As String)
Dim AcroApp As Acrobat.CAcroApp
Dim jso As Object
Dim KurzGesamt As Acrobat.CAcroPDDoc
Dim i As Integer, intPages As Integer
Dim objTextfeld As Object

Set AcroApp = CreateObject("AcroExch.App")
Set KurzGesamt = CreateObject("AcroExch.PDDoc")
KurzGesamt.Open (sFile)
Set jso = KurzGesamt.GetJSObject
intPages = KurzGesamt.GetNumPages

For i = 0 To intPages - 1
    Set objTextfeld = jso.AddField("Textfeld" & i, "text", i, Array(250, 50, 300, 0))
    objTextfeld.Value = "--" & Str(i + 1) & " --"
    objTextfeld.textSize = 10
    objTextfeld.textFont = "Calibri"
Next i

jso.FlattenPages

Call KurzGesamt.Save(1, sFile)

Set jso = Nothing
Call AcroApp.CloseAllDocs
Set KurzGesamt = Nothing
Call AcroApp.Exit
Set AcroApp = Nothing
'Debug.Print "Done!"
End Sub

VBA, Acrobat Pro Add Header&Footer to Pdf

2 Answers2