Please help with my script to count pages in a PDF file

[Onenguyen]

Hi All!

I have a script that counts the pages in a PDF. I come across a lot of jobs were there are numerous subfolders within a folder and I want the script to be able to give me counts off all the PDF files, including the subfolders. Right now I have to place the script in each subfolder, run it, and combine the text file to get the total number of pages for the whole folder. Is there anyway I can modify the script to go into the subfolders and give me a complete page count of all the PDFs?

Also, is there a way to modify the script to give me a complete page count of all the PDFs?

Thanks for your help

Script:

'File: pdfpagecount.vbs
' Purpose: count pages in pdf file in folder
Const OPEN_FILE_FOR_READING = 1

Set gFso = WScript.CreateObject("Scripting.FileSystemObject")
Set gShell = WScript.CreateObject ("WSCript.shell")
Set gNetwork = Wscript.CreateObject("WScript.Network")

directory="."
set base=gFso.getFolder(directory)
call listPDFFile(base)

Function ReadAllTextFile(filespec)
Const ForReading = 1, ForWriting = 2
Dim f
Set f = gFspenTextFile(filespec, ForReading)
ReadAllTextFile = f.ReadAll
End Function

function countPage(sString)
Dim regEx, Match, Matches, counter, sPattern
sPattern = "/Type\s*/Page[^s]" ' capture PDF page count
counter = 0

Set regEx = New RegExp ' Create a regular expression.
regEx.Pattern = sPattern ' Set pattern "^rem".
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = True ' Set global applicability.
set Matches = regEx.Execute(sString) ' Execute search.
For Each Match in Matches ' Iterate Matches collection.
counter = counter + 1
Next
if counter = 0 then
counter = 1
end if
countPage = counter
End Function

sub listPDFFile(grp)
Set pf = gFso.CreateTextFile("pagecount.csv", True)
for each file in grp.files
if (".pdf" = lcase(right(file,4))) then
larray = ReadAllTextFile(file)
pages = countPage(larray)
pf.WriteLine(pages)
end if
next
pf.Close
end sub

 

[mrmovie]

'something like?

strDir = "f:\"
Set objDir = FSO.GetFolder(strDir)
getInfo(objDir)

Sub getInfo(pCurrentDir)

Set pf = gFso.CreateTextFile(pCurrentDir.Name & "\pagecount.csv", True)
for each file in grp.files
if (".pdf" = lcase(right(file,4))) then
larray = ReadAllTextFile(file)
pages = countPage(larray)
pf.WriteLine(pages)
end if
next
pf.Close

For Each aItem In pCurrentDir.SubFolders
'wscript.Echo aItem.Name & " passing recursively"
getInfo(aItem)
Next

End Sub

 

[Onenguyen]

Says there's an error on Line 2

 

[mrmovie]

it was an example, its not going to work off the bat

how about changing your sub listPDFFile to/...

sub listPDFFile(grp)
Set pf = gFso.CreateTextFile("pagecount.csv", True)
for each file in grp.files
if (".pdf" = lcase(right(file,4))) then
larray = ReadAllTextFile(file)
pages = countPage(larray)
pf.WriteLine(pages)
end if
next
pf.Close
For Each aItem In grp.SubFolders
'wscript.Echo aItem.Name & " passing recursively"
listPDFFile(aItem)
Next
end sub

 

[Onenguyen]

Sorry I'm really new to this and you have been a great help to me, but I'm pretty lost. Would I just copy and paste that into the script?

 

[mrmovie]

your existing sub is

sub listPDFFile(grp)
Set pf = gFso.CreateTextFile("pagecount.csv", True)
for each file in grp.files
if (".pdf" = lcase(right(file,4))) then
larray = ReadAllTextFile(file)
pages = countPage(larray)
pf.WriteLine(pages)
end if
next
pf.Close
end sub

replace it with

sub listPDFFile(grp)
Dim aItem
Set pf = gFso.CreateTextFile("pagecount.csv", True)
for each file in grp.files
if (".pdf" = lcase(right(file,4))) then
larray = ReadAllTextFile(file)
pages = countPage(larray)
pf.WriteLine(pages)
end if
next
pf.Close
For Each aItem In grp.SubFolders
wscript.Echo aItem.Name & " passing recursively"
listPDFFile(aItem)
Next
end sub

 

[Onenguyen]

Okay so I think I figured it out, but its only outputing the pages for 1 subfolder. Can I get it to give me each individual subfolder?

 

[mrmovie]

are you getting something good from

wscript.echo aitem.name & "passing recurisbely"

instead of
Set pf = gFSO.CreateTextFile("
you could try
Set pf = gFSO.OpenTextFile("c:\pagecount.csv", 8, True)

or you will need to create your csv file outside of the Sub and pass it as a parameter to the sub, that way it will 'persist' through each of the sub folders.?

or you may want to change the CreateTextFile to CreateTextFile(grp.Name or grp.FullPath & "\pagecount.csv"
depends on what you want

 

[Onenguyen]

Here's an example of my problem:

I have a Folder named "TEST"

there are 2 subfolders named "TEST1" and "TEST2"

Your change works but only gives me the pages for "TEST2"

I have placed the script in the TEST folder so you can see "TEST1" "TEST2" and SCRIPT

 

[mrmovie]

how many csv files do you want to end up with?

 

[Onenguyen]

I am getting the passing recursively prompt.

I think maybe its replacing the data from the first folder with the data from the second folder because when I see that prompt and click okay I see the file being created and when it moves to the second subfolder it records only the data for the second folder. Can we combine the information so it displays both?

 

[Onenguyen]

I'm only getting 1 CSV file.

 

[Onenguyen]

Is there anyway to have it create 1 total CSV file instead of separate files per folder?

 

[mrmovie]

'????
Set pf = gFso.CreateTextFile("pagecount.csv", True)

Call listPDFFile(base, pf)

sub listPDFFile(grp, pf)
Dim aItem

for each file in grp.files
if (".pdf" = lcase(right(file,4))) then
larray = ReadAllTextFile(file)
pages = countPage(larray)
pf.WriteLine(pages)
end if
next
For Each aItem In grp.SubFolders
wscript.Echo aItem.Name & " passing recursively"
listPDFFile(aItem, pf)
Next
end sub

 

[Onenguyen]

Mr. Movie,

I just want to have 1 CSV file, but the script isn't adding the total documents to one certain csv. It looks like its creating a csv file for each folder. Since it is the same output filename it is saving over each previous list and the end result is a list of the last folder. Is there a way to compile a complete list of all the folders?

 

[Onenguyen]

It says that you cannot use parenthesis while calling a sub. I have so far:

' By Chanh Ong
'File: pdfpagecount.vbs
' Purpose: count pages in pdf file in folder
Const OPEN_FILE_FOR_READING = 1

Set gFso = WScript.CreateObject("Scripting.FileSystemObject")
Set gShell = WScript.CreateObject ("WSCript.shell")
Set gNetwork = Wscript.CreateObject("WScript.Network")

directory="."
set base=gFso.getFolder(directory)
call listPDFFile(base)

Function ReadAllTextFile(filespec)
Const ForReading = 1, ForWriting = 2
Dim f
Set f = gFspenTextFile(filespec, ForReading)
ReadAllTextFile = f.ReadAll
End Function

function countPage(sString)
Dim regEx, Match, Matches, counter, sPattern
sPattern = "/Type\s*/Page[^s]" ' capture PDF page count
counter = 0

Set regEx = New RegExp ' Create a regular expression.
regEx.Pattern = sPattern ' Set pattern "^rem".
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = True ' Set global applicability.
set Matches = regEx.Execute(sString) ' Execute search.
For Each Match in Matches ' Iterate Matches collection.
counter = counter + 1
Next
if counter = 0 then
counter = 1
end if
countPage = counter
End Function

Set pf = gFso.CreateTextFile("pagecount.csv", True)

Call listPDFFile(base, pf)

sub listPDFFile(grp, pf)
Dim aItem

for each file in grp.files
if (".pdf" = lcase(right(file,4))) then
larray = ReadAllTextFile(file)
pages = countPage(larray)
pf.WriteLine(pages)
end if
next
For Each aItem In grp.SubFolders
wscript.Echo aItem.Name & " passing recursively"
listPDFFile(aItem, pf)
Next


end sub

 

[mrmovie]

this needs to go near the top of your script (move it from where you have put it)

Set pf = gFso.CreateTextFile("pagecount.csv", True)
Call listPDFFile(base, pf)

it replaces the line

call listPDFFile(base)

 

[Onenguyen]

Thank you so much for helping me and I think its almost ready but its telling me I have an error. It says that I cannont use parentheses when calling a sub, line 53 character 26:

Can you please look over what I have and tell me if I'm doing something wrong.


'File: pdfpagecount.vbs
' Purpose: count pages in pdf file in folder
Const OPEN_FILE_FOR_READING = 1

Set gFso = WScript.CreateObject("Scripting.FileSystemObject")
Set gShell = WScript.CreateObject ("WSCript.shell")
Set gNetwork = Wscript.CreateObject("WScript.Network")

directory="."
set base=gFso.getFolder(directory)
Set pf = gFso.CreateTextFile("pagecount.csv", True)
Call listPDFFile(base, pf)

Function ReadAllTextFile(filespec)
Const ForReading = 1, ForWriting = 2
Dim f
Set f = gFspenTextFile(filespec, ForReading)
ReadAllTextFile = f.ReadAll
End Function

function countPage(sString)
Dim regEx, Match, Matches, counter, sPattern
sPattern = "/Type\s*/Page[^s]" ' capture PDF page count
counter = 0

Set regEx = New RegExp ' Create a regular expression.
regEx.Pattern = sPattern ' Set pattern "^rem".
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = True ' Set global applicability.
set Matches = regEx.Execute(sString) ' Execute search.
For Each Match in Matches ' Iterate Matches collection.
counter = counter + 1
Next
if counter = 0 then
counter = 1
end if
countPage = counter
End Function

sub listPDFFile(grp, pf)
Dim aItem

for each file in grp.files
if (".pdf" = lcase(right(file,4))) then
larray = ReadAllTextFile(file)
pages = countPage(larray)
pf.WriteLine(pages)
end if
next
For Each aItem In grp.SubFolders
wscript.Echo aItem.Name & " passing recursively"
listPDFFile(aItem, pf)
Next

end sub

 

[tsuji]

>listPDFFile(aItem, pf)
Since you use call somewhere above, that it allows you to use parentheses wrapping around the aruments, you can do the same here.
[tt] call listPDFFile(aItem, pf)[/tt]
or without call keyword, take away the parentheses, that's how vbs works.
[tt] listPDFFile aItem, pf[/tt]

 

[Onenguyen]

Thank you for your fast response. It looks like its working, however, its not giving me the right page counts for the PDF files. It list me all the correct files in the folder, but its off by a couple hundred pages. Is there anything you can see in the formula that isnt right???