Count PDF pages in sub-folders

[cucsoi]

Hi all,
I'm not good in VBA, I got below script from internet to count pdf pages in folder (with Acrobat Pro), but not count pages inside sub-folders, can you help me to count pdf pages in all sub-folders
Thanks

Sub GetPDFNumberOfPages()
Dim FSO As Object
Dim F_Fol As Object
Dim F_File As Object
Dim T_Str As String
Dim Dlg_Fol As FileDialog
'In VBE, add reference: Tools > References... > Acrobat > OK
Dim Ac_Fi As Acrobat.AcroPDDoc
Dim i As Long

Set Dlg_Fol = Application.FileDialog(msoFileDialogFolderPicker)
If Dlg_Fol.Show = -1 Then
T_Str = Dlg_Fol.SelectedItems(1)
Else: Set Dlg_Fol = Nothing
End If
Set Dlg_Fol = Nothing
Set FSO = CreateObject("Scripting.FileSystemObject")
Set F_Fol = FSO.getfolder(T_Str)
i = 2
For Each F_File In F_Fol.Files
T_Str = UCase(F_File.Path)
If Right(T_Str, 4) = ".PDF" Then
Set Ac_Fi = New Acrobat.AcroPDDoc
Ac_Fi.Open T_Str
Cells(i, 1).Value = T_Str
Cells(i, 2).Value = Ac_Fi.GetNumPages
i = i + 1
Ac_Fi.Close
Set Ac_Fi = Nothing
End If
Next

Range("A:B").Columns.AutoFit

Set F_File = Nothing
Set F_Fol = Nothing
Set FSO = Nothing
End Sub

 

[brawnystaff]

Private RegExp As Object
Private FSO As Object
Private nextRow As Long
Public Sub GetPDFNumberOfPages()
  
Dim rootFolderPath As String
Dim folderPicker As FileDialog
Dim newWorksheet As Worksheet

Set folderPicker = Application.FileDialog(msoFileDialogFolderPicker)
With folderPicker
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = Environ("UserProfile")
    If .Show <> -1 Then Exit Sub
    rootFolderPath = .SelectedItems(1)
End With
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
Set FSO = CreateObject("Scripting.FileSystemObject")
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
nextRow = 2

On Error Resume Next
Set newWorksheet = Sheets("PDF_List")
If newWorksheet Is Nothing Then
    Set newWorksheet = Sheets.Add(After:=Sheets(Sheets.Count))
    newWorksheet.Name = "PDF_List"
Else
    newWorksheet.Activate
    newWorksheet.Cells.ClearContents
End If
'Prompt for subfolder option
    Resp = MsgBox(prompt:="Index Subfolders as well?", _
    Buttons:=vbYesNo, Title:="Subdirectories?")
    If Resp = vbYes Then
ScanFolderForPdf rootFolderPath, True
Else
ScanFolderForPdf rootFolderPath, False
End If
    Cells(1, "A").Value = " Path "
    Cells(1, "B").Value = " Count "
    Range("A1").EntireRow.Font.Bold = True
    Range("A:B").Columns.AutoFit
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub
Public Sub ScanFolderForPdf(thisFolderPath As String, sdir As Boolean)

Dim thisfolder As Object
Dim subFolder As Object
Dim folderFile As Object
Set thisfolder = FSO.GetFolder(thisFolderPath)
If sdir = False Then GoTo Root
For Each subFolder In thisfolder.SubFolders
    ScanFolderForPdf subFolder.Path, True
Next subFolder

Root:
For Each folderFile In thisfolder.Files
    If StrComp(Right(folderFile.Path, 4), ".pdf", vbTextCompare) = 0 Then
        Cells(nextRow, "A").Value = folderFile.Path
        Cells(nextRow, "B").Value = GetPdfPageCount(folderFile.Path)
        nextRow = nextRow + 1
    End If
Next folderFile

End Sub
Function GetPdfPageCount(filePath) As Long
    Dim acroDoc As Object

    Set acroDoc = New AcroPDDoc
    acroDoc.Open filePath

    GetPdfPageCount = acroDoc.GetNumPages
    acroDoc.Close
End Function

 

[cucsoi]

Private RegExp As Object
Private FSO As Object
Private nextRow As Long
Public Sub GetPDFNumberOfPages()
 
Dim rootFolderPath As String
Dim folderPicker As FileDialog
Dim newWorksheet As Worksheet

Set folderPicker = Application.FileDialog(msoFileDialogFolderPicker)
With folderPicker
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = Environ("UserProfile")
    If .Show <> -1 Then Exit Sub
    rootFolderPath = .SelectedItems(1)
End With
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
Set FSO = CreateObject("Scripting.FileSystemObject")
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
nextRow = 2

On Error Resume Next
Set newWorksheet = Sheets("PDF_List")
If newWorksheet Is Nothing Then
    Set newWorksheet = Sheets.Add(After:=Sheets(Sheets.Count))
    newWorksheet.Name = "PDF_List"
Else
    newWorksheet.Activate
    newWorksheet.Cells.ClearContents
End If
'Prompt for subfolder option
    Resp = MsgBox(prompt:="Index Subfolders as well?", _
    Buttons:=vbYesNo, Title:="Subdirectories?")
    If Resp = vbYes Then
ScanFolderForPdf rootFolderPath, True
Else
ScanFolderForPdf rootFolderPath, False
End If
    Cells(1, "A").Value = " Path "
    Cells(1, "B").Value = " Count "
    Range("A1").EntireRow.Font.Bold = True
    Range("A:B").Columns.AutoFit
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub
Public Sub ScanFolderForPdf(thisFolderPath As String, sdir As Boolean)

Dim thisfolder As Object
Dim subFolder As Object
Dim folderFile As Object
Set thisfolder = FSO.GetFolder(thisFolderPath)
If sdir = False Then GoTo Root
For Each subFolder In thisfolder.SubFolders
    ScanFolderForPdf subFolder.Path, True
Next subFolder

Root:
For Each folderFile In thisfolder.Files
    If StrComp(Right(folderFile.Path, 4), ".pdf", vbTextCompare) = 0 Then
        Cells(nextRow, "A").Value = folderFile.Path
        Cells(nextRow, "B").Value = GetPdfPageCount(folderFile.Path)
        nextRow = nextRow + 1
    End If
Next folderFile

End Sub
Function GetPdfPageCount(filePath) As Long
    Dim acroDoc As Object

    Set acroDoc = New AcroPDDoc
    acroDoc.Open filePath

    GetPdfPageCount = acroDoc.GetNumPages
    acroDoc.Close
End Function

Thank brawnystaff, you're the best

 

[cucsoi]

hi brawnystaff,
is there any way to count A4 and A5 pages in pdf files?
Thanks