如何使用 VBA 获取 pdf 文档中的页数？

Question

我将发布我对这个问题的解决方案，但也许其他人已经找到了更好的方法。

我想使用 VBA 获取 pdf 文档的页数。

我查看了类似的 [vba] 和 [acrobat] 问题，但没有找到独立的解决方案。在查看了其他帖子、Adobe Acrobat 的 SDK 和 VBA 对象浏览器之后，我学到了足够多的知识来拼凑这个解决方案。

我正在运行 Excel 2013 和 Adob​​e Acrobat 9.0 Pro。

我了解answer my own question 可以。

Answer 1

灵感来自：https://www.extendoffice.com/documents/excel/5330-excel-vba-pdf-page-count.html

我创建了下面的函数。我没有安装 Adob​​ acrobat pro。

子测试()

Dim vFolder, vFileName

vFolder = "D:\Test Count Pages In PDF File\"
'vFolder = "D:\Test Count Pages In PDF File\" '--> fine for both forms (with or without PathSeparator)
vFileName = "My File.pdf"
Debug.Print fNumberOfPages_in_PDF_File(vFolder, vFileName)
    

结束子

函数 fNumberOfPages_in_PDF_File(vFolder, vFileName)

Dim xStr As String
Dim xFileNum As Long
Dim RegExp As Object

'--- Number of Pages =0 if the file is not a PDF file
If Not vFileName Like "*.pdf" Then
    fNumberOfPages_in_PDF_File = 0
    Exit Function
End If

'--- Add PathSeparator ("\") if it does not exist
If Right(vFolder, 1) <> Application.PathSeparator Then
    vFolder = vFolder & Application.PathSeparator
End If

'--- Count the number of pages in Pdf File
xStr = ""
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
xFileNum = FreeFile
Open (vFolder & vFileName) For Binary As #xFileNum
    xStr = Space(LOF(xFileNum))
    Get #xFileNum, , xStr
Close #xFileNum

fNumberOfPages_in_PDF_File = RegExp.Execute(xStr).Count

结束函数

Answer 2

Option Explicit
Public PDFDoc As AcroPDDoc, PDFPage As Object, A3&, A4&
Sub Main()
    Dim fso As FileSystemObject, fld As Folder, filePDF As File, fileName$, i&, Arr()
    Set fso = New FileSystemObject
    Set PDFDoc = New AcroPDDoc
    Set fld = fso.GetFolder(ThisWorkbook.Path)
    ReDim Arr(1 To 1000, 1 To 4)
    For Each filePDF In fld.Files
    
     Application.Calculation = xlCalculationManual
    
        fileName = filePDF.Name
        If Right(fileName, 4) = ".pdf" Then
            CountPagesPDF (ThisWorkbook.Path & "\" & fileName)
            i = i + 1
            Arr(i, 1) = fileName
            Arr(i, 2) = A3 + A4
            Arr(i, 3) = A3
            Arr(i, 4) = A4
            
        End If
    Next
    Range("A3:D" & Cells.Rows.Count).Clear
    Range("A3:D" & (i + 1)) = Arr
    Set PDFPage = Nothing
    Set PDFDoc = Nothing
    Set fso = Nothing
    
     Application.Calculation = xlCalculationAutomatic
    
End Sub

Sub CountPagesPDF(FullFileName$)
    Dim j&, n&, x, y
    A3 = 0
    A4 = 0
    PDFDoc.Open (FullFileName)
    n = PDFDoc.GetNumPages
    
    Application.Calculation = xlCalculationManual
    
    For j = 0 To n - 1
        Set PDFPage = PDFDoc.AcquirePage(j)
        x = PDFPage.GetSize().x
        y = PDFPage.GetSize().y
        If x + y > 1500 Then A3 = A3 + 1 Else A4 = A4 + 1
    Next
    
    Application.Calculation = xlCalculationAutomatic
    
    PDFDoc.Close
End Sub

Answer 3

此解决方案在安装 Excel 2013 Professional 和 Adob​​e Acrobat 9.0 Pro 时有效。

您需要启用 Adob​​e 对象模型：工具 -> 参考 -> 选中 Acrobat 复选框。

Adobe's SDK 关于 GetNumPages 方法的文档有限。

'with Adobe Acrobat 9 Professional installed
'with Tools -> References -> Acrobat checkbox selected

Sub AcrobatGetNumPages()

Dim AcroDoc As Object

Set AcroDoc = New AcroPDDoc

AcroDoc.Open ("C:\Users\Public\Lorem ipsum.pdf") 'update file location

PageNum = AcroDoc.GetNumPages

MsgBox PageNum

AcroDoc.Close

End Sub