Count page of pdf

[Thomas Kuriakose]

Respected Sirs,

I have used the below code to display all the files listed in a folder.

Option Explicit
Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)


Dim FSO As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim r As Long
 

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)

r = Range("A70000").End(xlUp).Row + 1

For Each FileItem In SourceFolder.Files

   
     Cells(r, 1).Formula = FileItem.Name
     Cells(r, 2).Formula = FileItem.Path
     Cells(r, 3).Formula = FileItem.Size
     Cells(r, 4).Formula = FileItem.DateCreated
     Cells(r, 5).Formula = FileItem.DateLastModified
   
     r = r + 1
   
Next FileItem


If IncludeSubfolders Then
     For Each SubFolder In SourceFolder.SubFolders
        'Calling same procedure for sub folders
        ListFilesInFolder SubFolder.Path, True
     Next SubFolder
End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

ActiveWorkbook.Saved = True

End Sub
Sub TestListFilesInFolder()


Dim FolderPath As String


Application.ScreenUpdating = False


FolderPath = Sheet1.txtPath.Value

ActiveSheet.Activate

We need to add a column before file size column (C) and the header will be Number of Pages for the pdf files in the folder. All the pdf files number of pages should be added in this column.

I found one code but don't know how to adapt this along with the list files 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
        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
        Columns("A:B").AutoFit
    End If
End Sub

Columns("A:E").Select
Selection.ClearContents



Range("A6").Formula = "File Name:"
Range("B6").Formula = "Path:"
Range("C6").Formula = "File Size:"
Range("D6").Formula = "Date Created:"
Range("E6").Formula = "Date Last Modified:"


Range("A6:E6").Font.Bold = True


ListFilesInFolder FolderPath, True


'Columns("A:E").Select
'Selection.Columns.AutoFit

Range("A1").Select

End Sub

Kindly find attached the file you your reference.

Thank you very much for your kind support always,

with regards,
thomas