Dear Friends,
I found this code for scanning of folder for PDF files, counting number of pages and exporting of result to worksheet.
Sub PDFandNumPages()
Dim Folder As Object
Dim file As Object
Dim fso As Object
Dim iExtLen As Integer, iRow As Integer
Dim sFolder As String, sExt As String
Dim sPDFName As String
sExt = "pdf"
iExtLen = Len(sExt)
iRow = 2
' Must have a '\' at the end of path
sFolder = "C:\Users\ismi\Desktop\14_Editable_Copy_18SEP\"
Set fso = CreateObject("Scripting.FileSystemObject")
If sFolder <> "" Then
Set Folder = fso.GetFolder(sFolder)
For Each file In Folder.files
If Right(file, iExtLen) = sExt Then
Cells(iRow, 1).Value = file.Name
Cells(iRow, 2).Value = pageCount(sFolder & file.Name)
iRow = iRow + 1
End If
Next file
End If
End Sub
Function pageCount(sFilePathName As String) As Integer
Dim nFileNum As Integer
Dim sInput As String
Dim sNumPages As String
Dim iPosN1 As Integer, iPosN2 As Integer
Dim iPosCount1 As Integer, iPosCount2 As Integer
Dim iEndsearch As Integer
' Get an available file number from the system
nFileNum = FreeFile
'OPEN the PDF file in Binary mode
Open sFilePathName For Binary Lock Read Write As #nFileNum
' Get the data from the file
Do Until EOF(nFileNum)
Input #1, sInput
sInput = UCase(sInput)
iPosN1 = InStr(1, sInput, "/N ") + 3
iPosN2 = InStr(iPosN1, sInput, "/")
iPosCount1 = InStr(1, sInput, "/COUNT ") + 7
iPosCount2 = InStr(iPosCount1, sInput, "/")
If iPosN1 > 3 Then
sNumPages = Mid(sInput, iPosN1, iPosN2 - iPosN1)
Exit Do
ElseIf iPosCount1 > 7 Then
sNumPages = Mid(sInput, iPosCount1, iPosCount2 - iPosCount1)
Exit Do
' Prevent overflow and assigns 0 to number of pages if strings are not in binary
ElseIf iEndsearch > 1001 Then
sNumPages = "0"
Exit Do
End If
iEndsearch = iEndsearch + 1
Loop
' Close pdf file
Close #nFileNum
pageCount = CInt(sNumPages)
End Function
I found that this code does not find the PDF files that stored in subfolders. Also I need to define needed path via "Dialog window".
Please help me to solve this problem, because this macro is very necessary for my work.
Thanks and have a nice day
Bookmarks