Get the number of pages and file names of pdf files using third party application and write it to excel

[prati]

Hey
I am new member in this forum, i will do my best efforts to be specifc and clear and respect the time of the members.I am a begginer in VBA and need your help.
in the last month i search for a solution of a VBA code that can retrieve information about pdf files and write that information into excel.
I need a vba code that can count pdf pages and write to excell for each pdf the file name and number of pages.

i have tried several vba codes-

How to count the page numbers of Pdf files in Excel?

www.extendoffice.com

VBA Page Count

Hello Everyone, I have nearly 1500 Pdf files, Each have its own name. So, I have to Open the pdf and List the page numbers in Excel. So, I need a macro code to open the pdf and count the page numbers and post it into excel. Can i Get Any Help from you Guys, Krish.

www.mrexcel.com

None of the codes is perfect. of course sometimes the vba count the pages correctly, but there are alwayes mistakes with files.
Sometimes counting more pages than the real, sometimess less.

After couple of weeks i realized that the best to count pdf pages is a VBA that use third party application- for example the VBA code bellow using adobe acrobat proffesional-

Get page count of pdf files [Archive] - VBA Express Forum

Hi VB'ers :), Is it possible to get the page count of pdf files through vb code? Like the pdfs are saved in one folder and it will list their filenames and page count of each in a simple excel sheet? Please help I really need this one. Any help would be very much appreciated. Thanks a...

www.vbaexpress.com

It works perfect, counting the correct number of pages. No mistakes at all - but it is not free.....you need acrobat for that (not reader)

I need a free solution and not a VBA that use adobe acrobat.

I can think about 3 free main options but have no idea how to write code for them.

1 option to write a VBA thay willl use PDFtk, that will retrieve the information without opening the graphical interface

Second option is to write a vba that will use Pdfinfo

Third and last option is to write a vba code that use pdfsam also without really opening the interface- just insall pdfsam and write a vba that will use it for counting pages

Any other free solution will be perfect as well as long as the vba code can look at c:\tempand then write to excel cells 2 types of information:

1. The file name
2. The number of pages

In another words, a need a VBA that can do the job without "really" opening the the third party interface, and yet get the correct number of pdf pages.
you can read here why counting pdf pages without third party application is very tricky

https://www.reddit.com/r/visualbasic/comments/29n2xa

Thanks in advance for your help

 

[prati]

Hey again,
Is there a way that the command window will be invisible during the process?
If not, is there a way that the command window will be behind the excel window?

 

[John_w]

Is there a way that the command window will be invisible during the process?

Yes, instead of WshShell Exec we can use the Run method and hide the command window, and the PDFtk dump_data output option to output the data to a text file which we read.

Option Explicit

Const Q As String = """"

Public Sub Count_PDF_Pages2()

    Dim PDFfileSpec As String, PDFfolder As String, PDFfileName As String
    Dim Wsh As Object 'WshShell
    Dim FSO As Object 'FileSystemObject
    Dim tempFile As String
    Dim command As Variant
    Dim output As Variant
    Dim pageCount As String
    Dim r As Long
        
    PDFfileSpec = "C:\path\to\folder\*.pdf"                 'CHANGE FOLDER PATH
    
    Set Wsh = CreateObject("WScript.Shell")                 'New WshShell
    Set FSO = CreateObject("Scripting.FileSystemObject")    'New FileSystemObject
    tempFile = Environ$("temp") & "\temp.txt"
    
    PDFfolder = Left(PDFfileSpec, InStrRev(PDFfileSpec, "\"))
    
    With ActiveSheet
        
        .Cells.ClearContents
        .Range("A1:B1").Value = Array("File Name", "Page Count")
        r = 2
        
        PDFfileName = Dir(PDFfileSpec)
        While PDFfileName <> vbNullString
            
            command = "cmd /c PDFtk " & Q & PDFfolder & PDFfileName & Q & " dump_data output " & Q & tempFile & Q
            Wsh.Run command, 0, True
            
            If FSO.FileExists(tempFile) Then
                output = FSO.OpenTextFile(tempFile).ReadAll
                FSO.DeleteFile tempFile
                pageCount = Split(Split(output, "NumberOfPages: ")(1), vbCrLf)(0)
                .Cells(r, 1).Resize(, 2).Value = Array(PDFfileName, pageCount)
            Else
                .Cells(r, 1).Resize(, 2).Value = Array(PDFfileName, "Error opening file")
            End If
            
            r = r + 1
            PDFfileName = Dir
            DoEvents
            
        Wend
        
    End With
    
End Sub

 

[prati]

Many Thanks.
You are a genius or even more than that

 

[mpdrsn]

This will require the Adobe Acrobat Exchange server installed with Acrobat Pro or Acrobat DC.

Public Sub GetPageCountForPDFs()
  Dim sPath As String, sFolder As String, sFile As String, l As Integer, Key
  Dim oShell As Object, oFolder As Object, oFolders As Object, oFiles As Object
  Dim ws As Worksheet, oAdobe As Object, oPdDoc As Object
' Finds all PDFs in folders and subfolders with number of pages per file.

  ' SELECT FOLDER:
  Set oShell = CreateObject("Shell.Application")
  Set oFolder = oShell.BrowseForFolder(0, "Open PDF Folder:", 0, 17)

  If oFolder Is Nothing Then Exit Sub

  sPath = oFolder.Self.Path & Application.PathSeparator

  Set oFolder = Nothing
  Set oShell = Nothing

  ' CREATE OBJECTS:
  Set oFolders = CreateObject("Scripting.Dictionary")
  Set oFiles = CreateObject("Scripting.Dictionary")

  With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
  End With

  ' LIST ALL FOLDERS:
  oFolders.Add (sPath), vbNullString
  l = 0
  Do While l < oFolders.Count
    Key = oFolders.Keys
    sFolder = Dir(Key(l), vbDirectory)
    Do While sFolder <> vbNullString
      If sFolder <> "." And sFolder <> ".." Then
        If (GetAttr(Key(l) & sFolder) And vbDirectory) = vbDirectory Then
          oFolders.Add (Key(l) & sFolder & "\"), vbNullString
        End If
      End If
      sFolder = Dir
    Loop
    l = l + 1
  Loop

  ' CREATE ADOBE EXCHANGE OBJECTS:
  Set oAdobe = CreateObject("AcroExch.App")
  Set oPdDoc = CreateObject("AcroExch.PdDoc")

  ' LIST ALL FILES:
  For Each Key In oFolders.Keys
    sFile = Dir(Key & "*.pdf", vbDirectory)  ' ONLY PDF FILES
    Application.StatusBar = sFile
    Do While sFile <> vbNullString
      sFolder = Key

      ' OPEN PDF FILE, GET NUMBER OF PAGES, AND THEN CLOSE:
      Call oPdDoc.Open(sFolder & sFile)
      oFiles.Add (sFolder & sFile), oPdDoc.GetNumPages()
      oPdDoc.Close

      sFile = Dir
    Loop
  Next

  ' LIST FILES IN WORKSHEET:
  With ActiveWorkbook
    For Each ws In .Sheets
      If ws.Name = "Files" Then
        ws.Cells.Delete
        Exit For
      End If
    Next
    If ws Is Nothing Then Set ws = .Sheets.Add: ws.Name = "Files"
  End With

  ws.[A2].Resize(oFiles.Count, 1) = Application.Transpose(oFiles.Keys)
  ws.[B2].Resize(oFiles.Count, 1) = Application.Transpose(oFiles.Items)

  Set oFolders = Nothing
  Set oFiles = Nothing

  With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
    .StatusBar = False
  End With

  Set oAdobe = Nothing
  Set oPdDoc = Nothing
End Sub