Extract Page count of pdf in macro

Hi Mohan,

check out this attached file and let me know is it for your looking for

Hi mohan

replace below code

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\NaveedM\Downloads\Excel Forum\pdf\"
   
   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

The code below works for me and correctly puts the file name in column A with pages in column B
I have tried it with Excel2010 and Excel2016 and BOTH work
I am also using Windows7
Try my file attached - amend the folder path, then run PDFandNumPages

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 = "D:\Documents\TestFolder\"
   
   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

How do you expect me to work that out when you provide no information?

Please post your modified code enclosed in code tags

thanks

Please post your code as requested

Also attach an example pdf file

thanks

(the code works for me with all pdf's on my computer, but your pdf file may have a different structure???)

Please attach 2 pdf files for me to test
- pdf(1) = where page count = 0
- pdf(2) = where page count > 0

Try modifying the code. Please add one line of code after this line:

ElseIf iEndsearch > 1001 Then

add this line:

MsgBox "Overflow tripped"

Does the message pop up when you run the code on the "bad" machine?

post deleted by kev_

I have amended the macro to provide me with extra information on sheet named "sInput" in attached workbook

Please:
1 amend this line in the macro to match a folder on your system

sFolder = "D:\Documents\TestFolder\"

2 Put 10 pdf files in that folder

3 run the macro

4 manually enter the number of pages against each file in column B on sheet FileList

5 attach the workbook to your reply

thanks