UPDATE - Macro to Get Page Count of PDF Files

UPDATE - Macro to Get Page Count of PDF Files

April 14, 2017

Here's an update to my tip of a couple of nights ago, where I posted VBA code for Excel that can be used to get the page counts of PDFs in a specified folder.    I have been using that code at work and noticed that it doesn't always give the correct page counts.   


In the same forum, Ralajer posted a different VBA code to accomplish the same task.   I tested it on a random sample of PDFs from my PC, and while it didn't work perfectly, it did have an advantage over the code posted on April 11.    The prior code will unaccountably give incorrect page counts that can be off by many pages.   This code will either give a count of 0 if it can't determine the page count, or the VBA code will give you a run time error if the folder has a PDF it can't process at all.   At least with this code you are alerted when there's a problem.   For the PDFs that it does give a non-zero count for, I did not find any mistakes. 



Don't forget the Tip of the Night for June 29, 2015 when I posted about a free utility that will give you a list showing PDF page counts.  







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 = 1
   ' Must have a '\' at the end of path
   sFolder = "C:\pdf_Directory\"
   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
  ' Close pdf file
  Close #nFileNum
  pageCount = CInt(sNumPages)
End Function


Please reload

Contact Me With Your Litigation Support Questions:


  • Twitter Long Shadow

© 2015 by Sean O'Shea . Proudly created with Wix.com