Hi, John,

Hi, sroczeto,
To count the page number of .doc and .docx as well as the PDF files, please apply the following code:
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
Dim xWdApp
Dim xWd
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
Application.ScreenUpdating = False
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
Set xRg = Range("A1")
Range("A:B").ClearContents
Range("A1:B1").Font.Bold = True
xRg = "File Name"
xRg.Offset(0, 1) = "Pages"
I = 2
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
I = I + 1
xFileName = Dir
Loop
xFileName = Dir(xFdItem & "*.docx", vbDirectory)
Set xWdApp = CreateObject("Word.Application")
Do While xFileName <> ""
Cells(I, 1) = xFileName
xFileNum = FreeFile
Set xWd = GetObject(xFdItem & xFileName)
Cells(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Close False
I = I + 1
xFileName = Dir
Loop
Columns("A:B").AutoFit
End If
Application.ScreenUpdating = True
End Sub

Hello, Daphne,
For solving your problem, please apply the below code, please try, hope it can help you!

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

Hello, Prashant,
To get the number of all the PDF files from folder and subfolders, please apply the below code:

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"
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
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

Please try, hope it can help you!

The code is good structure for how to do this kind of thing but that regexp will give unreliable results for many pdfs. The regexp being searched for (/Type\s*/Page[^s]), will not work in SECURED pdfs (count will be zero). Also pdfs tools and versions vary in how they mark pages. It could be accurate if you know that all your pdfs are created using the same structure (version and tools).

Hi, Fawaz,
The code works well in my Excel, which Excel version do you use?
Or you can send your detailed problem or pdf files to my Email: skyyang@extendoffice.com.

Thank you very much for posting such informative message