Question

我只是想知道为什么以下链接中的vbs代码没有正确计算pdf页面？它似乎在每个pdf中实际存在的页数的一半或更多。

http://docs.ongetc.com/index.php?q=content/pdf-pages-counting-using-vb-script

如果您无法访问上述链接，请输入以下代码：

' 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 = gFso.OpenTextFile(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.txt", True)
for each file in grp.files 
    if (".pdf" = lcase(right(file,4))) then 
      larray = ReadAllTextFile(file)
      pages = countPage(larray)
      wscript.echo "The " & file.name & " PDF file has " & pages & " pages"
      pf.WriteLine(file.name&","&pages) 
    end if
next 
  pf.Close
end sub

由于

Answer 1

试试这个

Function getPdfPgCnt(ByVal sPath)
    Dim strTStr

    With CreateObject("Adodb.Stream")
        .Open
        .Charset = "x-ansi"
        .LoadFromFile sPath
        strTStr = .ReadText(-1)
    End With

    With (New RegExp)
        .Pattern = "Type\s+/Page[^s]"
        .IgnoreCase = True
        .Global = True
        getPdfPgCnt = .Execute(strTStr).Count
    End With

    If getPdfPgCnt = 0 Then getPdfPgCnt = 1
End Function

'Usage : getPdfPgCnt("C:\1.pdf")

更新＃1~＃2：

Option Explicit

Private Function getPdfPgCnt(ByVal sPath) 'Returns page count of file on passed path
    Dim strTStr

    With CreateObject("Adodb.Stream")
        .Open
        .Charset = "x-ansi"
        .LoadFromFile sPath
        strTStr = .ReadText(-1)
    End With

    With (New RegExp)
        .Pattern = "Type\s*/Page[^s]"
        .IgnoreCase = True
        .Global = True
        getPdfPgCnt = .Execute(strTStr).Count
    End With

    If getPdfPgCnt = 0 Then getPdfPgCnt = 1
End Function

'--------------------------------
Dim oFso, iFile
Set oFso = CreateObject("Scripting.FileSystemObject")

'enumerating pdf files in vbs's base directory
For Each iFile In oFso.getFolder(oFso.GetParentFolderName(WScript.ScriptFullName)).Files
    If LCase(oFso.GetExtensionName(iFile)) = "pdf" Then WScript.Echo iFile & " has "& getPdfPgCnt(iFile)&" pages."
Next
Set oFso = Nothing
'--------------------------------

Answer 2

提供（和接受）的解决方案仅适用于有限数量的PDF文档。由于PDF文档经常压缩包括页面元数据在内的大块数据，因此粗略的正则表达式搜索“type \ s * / page [^ s]”通常会错过页面。

唯一真正可靠的解决方案是非常费力地分解PDF文档。我担心我没有工作的VBS解决方案，但我编写了Delphi函数，演示了如何执行此操作（参见http://www.angusj.com/delphitips/pdfpagecount.php）。

PDF页数不正确

2 个答案: