• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

UDF for pdf count pages

rsk.rlp

New Member
Sir I have too many pdf files i want count no.of pages in each pdf
I have no knowledge in this please help me thanks advance
 
Do you have Adobe Acrobat (not Acrobat Reader) installed?

VBA has no way to read PDF files, unless you have the libraries installed that come with Acrobat, which is a paid product.
 
Sir I have too many pdf files i want count no.of pages in each pdf
I have no knowledge in this please help me thanks advance
Try this:
>>> use code - tags <<<
Code:
Sub ListFilesofPDFandDOCinaFolder()
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
Dim xWdApp
Dim xWd
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
Application.ScreenUpdating = False
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
xFileName = Dir(xFdItem & "*.doc*", vbDirectory)
Set xWdApp = CreateObject("Word.Application")
Do While xFileName <> ""
Cells(i, 1) = xFileName
xFileNum = FreeFile
Set xWd = GetObject(xFdItem & xFileName)
Cells(i, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Close False
i = i + 1
xFileName = Dir
Loop
Columns("A:B").AutoFit
End If
Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:
Back
Top