Excel VBA提取带安全保护PDF页数的代码优化需求

Got it, let's fix this problem. Your current code works great for unprotected PDFs, but it fails on those with modify restrictions (no open password) because these files use permission-based encryption—even though you can open them without a password, lightweight file-reading methods can't access their page metadata.

The solution leans on Adobe Acrobat's official API (note: you'll need Adobe Acrobat Pro/Standard installed—Reader won't work here), which can handle these restricted PDFs as long as there's no open password required.

Optimized Code #

Let's replace your pageCount function with one that uses Acrobat's PDDoc object, which properly handles modify-restricted PDFs:

Sub PDFandNumPages()
    Dim Folder As Object
    Dim file As Object
    Dim fso As Object
    Dim iExtLen As Integer, iRow As Integer
    Dim sFolder As String, sExt As String
    
    sExt = "pdf"
    iExtLen = Len(sExt)
    iRow = 1
    sFolder = "C:\test\" ' Make sure this path ends with a backslash
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If sFolder <> "" Then
        Set Folder = fso.GetFolder(sFolder)
        For Each file In Folder.Files
            ' Case-insensitive check to catch .PDF and .pdf files
            If LCase(Right(file.Name, iExtLen)) = LCase(sExt) Then
                Cells(iRow, 1).Value = file.Name
                Cells(iRow, 2).Value = GetPDFPageCount(file.Path)
                iRow = iRow + 1
                DoEvents ' Keep Excel responsive during batch processing
            End If
        Next file
    End If
    
    ' Clean up objects to avoid memory leaks
    Set file = Nothing
    Set Folder = Nothing
    Set fso = Nothing
    
    MsgBox "Page count extraction finished!", vbInformation
End Sub

Function GetPDFPageCount(pdfPath As String) As Integer
    Dim acroPDDoc As Object
    Dim pageCount As Integer
    
    pageCount = 0 ' Default to 0 if the file can't be processed
    
    ' Handle errors for files with open passwords or other issues
    On Error Resume Next
    Set acroPDDoc = CreateObject("AcroExch.PDDoc")
    
    ' Acrobat automatically bypasses modify restrictions if no open password exists
    If acroPDDoc.Open(pdfPath) Then
        pageCount = acroPDDoc.GetNumPages()
        acroPDDoc.Close
    End If
    On Error GoTo 0
    
    Set acroPDDoc = Nothing
    GetPDFPageCount = pageCount
End Function

Key Improvements: #

• Uses Adobe Acrobat's COM API (AcroExch.PDDoc) which can recognize and access modify-restricted PDFs (as long as there's no open password).
• Added case-insensitive file extension check to cover both .pdf and .PDF files.
• Included error handling to avoid crashes if a PDF requires an open password (returns 0 for those, which you can adjust if needed).
• Added object cleanup to prevent memory leaks.
• Added DoEvents to keep Excel responsive while processing multiple files.

Important Notes: #

1. Adobe Acrobat Requirement: You need Adobe Acrobat Pro or Standard installed—Adobe Reader doesn't include the necessary COM objects for this functionality.
2. Open Passwords: This code returns 0 for PDFs that require an open password. Handling those would require adding password input logic, which is a more complex scenario.
3. Late Binding: The code uses late binding (CreateObject) so you don't need to manually add a reference to the Acrobat library in the VBA editor. If you prefer early binding, add a reference to "Adobe Acrobat xx.x Type Library" (replace xx.x with your installed version) and declare Dim acroPDDoc As AcroExch.PDDoc.

This should now correctly return page counts for both unprotected and modify-restricted PDFs without open passwords.

内容的提问来源于stack exchange，提问作者Pal S