Excel vba code to get page count for multiple PDF files

The below Visual Basic code, posted here by skyang, can be used to generate a list of PDF files which shows how many pages are in each file.

Simply enter the code in a new module in Visual Basic. Start from the beginning macro at Sub Test(), and after you press play you'll be prompted to select a folder where your PDF files are located.

This code will process any files saved to subfolders.

The code will generate a list like this which will also show the file size and file path of each PDF:

Note that if any file has a folder path longer than 255 characters, the code will fail and this message will come up.

As always, I have tested this code tonight and confirmed that it works - although in a large data set it did give a zero count for the pages in some PDFs. However it took less than 20 minutes to review more than 9000 files containing more than 80,000 pages.

Sub Test()

Dim I As Long

Dim xRg As Range

Dim xStr As String

Dim xFd As FileDialog

Dim xFdItem As Variant

Dim xFileName As String

Dim xFileNum As Long

Dim RegExp As Object

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

If xFd.Show = -1 Then

xFdItem = xFd.SelectedItems(1) & Application.PathSeparator

Set xRg = Range("A1")

Range("A:B").ClearContents

Range("A1:B1").Font.Bold = True

xRg = "File Name"

xRg.Offset(0, 1) = "Pages"

xRg.Offset(0, 2) = "Path"

xRg.Offset(0, 3) = "Size(b)"

I = 2

Call SunTest(xFdItem, I)

End If

End Sub

Sub SunTest(xFdItem As Variant, I As Long)

Dim xRg As Range

Dim xStr As String

Dim xFd As FileDialog

Dim xFileName As String

Dim xFileNum As Long

Dim RegExp As Object

Dim xF As Object

Dim xSF As Object

Dim xFso As Object

xFileName = Dir(xFdItem & "*.pdf", vbDirectory)

xStr = ""

Do While xFileName <> ""

Cells(I, 1) = xFileName

Set RegExp = CreateObject("VBscript.RegExp")

RegExp.Global = True

RegExp.Pattern = "/Type\s*/Page[^s]"

xFileNum = FreeFile

Open (xFdItem & xFileName) For Binary As #xFileNum

xStr = Space(LOF(xFileNum))

Get #xFileNum, , xStr

Close #xFileNum

Cells(I, 2) = RegExp.Execute(xStr).Count

Cells(I, 3) = xFdItem & xFileName

Cells(I, 4) = FileLen(xFdItem & xFileName)

I = I + 1

xFileName = Dir

Loop

Columns("A:B").AutoFit

Set xFso = CreateObject("Scripting.FileSystemObject")

Set xF = xFso.GetFolder(xFdItem)

For Each xSF In xF.SubFolders

Call SunTest(xSF.Path & "\", I)

Next

End Sub