How to get the number of pages in a pdf document using VBA?

Question

I will post my solution to this question, but maybe others have found a better way.

I wanted to obtain the number of pages in a pdf document using VBA.

I reviewed similar [vba] and [acrobat] questions, but I did not find a stand alone solution. After reviewing other posts, Adobe Acrobat's SDK, and the VBA object browser, I learned enough to piece together this solution.

I am running Excel 2013 and Adobe Acrobat 9.0 Pro.

I understand its ok to answer my own question.

Answer 1

Inspired from : https://www.extendoffice.com/documents/excel/5330-excel-vba-pdf-page-count.html

I created the function below. I do not have Adob accrobat pro installed.

Sub Test()

Dim vFolder, vFileName

vFolder = "D:\Test Count Pages In PDF File\"
'vFolder = "D:\Test Count Pages In PDF File\" '--> fine for both forms (with or without PathSeparator)
vFileName = "My File.pdf"
Debug.Print fNumberOfPages_in_PDF_File(vFolder, vFileName)
    

End Sub

Function fNumberOfPages_in_PDF_File(vFolder, vFileName)

Dim xStr As String
Dim xFileNum As Long
Dim RegExp As Object

'--- Number of Pages =0 if the file is not a PDF file
If Not vFileName Like "*.pdf" Then
    fNumberOfPages_in_PDF_File = 0
    Exit Function
End If

'--- Add PathSeparator ("\") if it does not exist
If Right(vFolder, 1) <> Application.PathSeparator Then
    vFolder = vFolder & Application.PathSeparator
End If

'--- Count the number of pages in Pdf File
xStr = ""
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
xFileNum = FreeFile
Open (vFolder & vFileName) For Binary As #xFileNum
    xStr = Space(LOF(xFileNum))
    Get #xFileNum, , xStr
Close #xFileNum

fNumberOfPages_in_PDF_File = RegExp.Execute(xStr).Count

End Function

Answer 2

Option Explicit
Public PDFDoc As AcroPDDoc, PDFPage As Object, A3&, A4&
Sub Main()
    Dim fso As FileSystemObject, fld As Folder, filePDF As File, fileName$, i&, Arr()
    Set fso = New FileSystemObject
    Set PDFDoc = New AcroPDDoc
    Set fld = fso.GetFolder(ThisWorkbook.Path)
    ReDim Arr(1 To 1000, 1 To 4)
    For Each filePDF In fld.Files
    
     Application.Calculation = xlCalculationManual
    
        fileName = filePDF.Name
        If Right(fileName, 4) = ".pdf" Then
            CountPagesPDF (ThisWorkbook.Path & "\" & fileName)
            i = i + 1
            Arr(i, 1) = fileName
            Arr(i, 2) = A3 + A4
            Arr(i, 3) = A3
            Arr(i, 4) = A4
            
        End If
    Next
    Range("A3:D" & Cells.Rows.Count).Clear
    Range("A3:D" & (i + 1)) = Arr
    Set PDFPage = Nothing
    Set PDFDoc = Nothing
    Set fso = Nothing
    
     Application.Calculation = xlCalculationAutomatic
    
End Sub

Sub CountPagesPDF(FullFileName$)
    Dim j&, n&, x, y
    A3 = 0
    A4 = 0
    PDFDoc.Open (FullFileName)
    n = PDFDoc.GetNumPages
    
    Application.Calculation = xlCalculationManual
    
    For j = 0 To n - 1
        Set PDFPage = PDFDoc.AcquirePage(j)
        x = PDFPage.GetSize().x
        y = PDFPage.GetSize().y
        If x + y > 1500 Then A3 = A3 + 1 Else A4 = A4 + 1
    Next
    
    Application.Calculation = xlCalculationAutomatic
    
    PDFDoc.Close
End Sub

Answer 3

This solution works when Excel 2013 Professional and Adobe Acrobat 9.0 Pro are installed.

You will need to enable the Adobe object model: Tools -> References -> Acrobat checkbox selected.

Adobe's SDK has limited documentation on the GetNumPages method.

'with Adobe Acrobat 9 Professional installed
'with Tools -> References -> Acrobat checkbox selected

Sub AcrobatGetNumPages()

Dim AcroDoc As Object

Set AcroDoc = New AcroPDDoc

AcroDoc.Open ("C:\Users\Public\Lorem ipsum.pdf") 'update file location

PageNum = AcroDoc.GetNumPages

MsgBox PageNum

AcroDoc.Close

End Sub