如何用vba读取pdf文件的总页数？

pdf 跟所有其它文件类型一样，有这个文件特有的文件格式。

通过查阅pdf文件格式的标准或者官方的文件格式文档，可以得知，如果用二进制形式打开pdf文件的话，”/Count”后面出现的数字即为总页数。

利用这个规则，可以使用如下的vba自定义函数获取pdf文件的总页数：

Function GetPageNum(ByVal sPath As String)
    Dim iFN As Integer
    iFN = VBA.FreeFile
    Dim bFileSize As Long
    bFileSize = VBA.FileLen(sPath)
    Open sPath For Binary Access Read As iFN
    Dim arrResult() As Byte
    '读取字节流
    arrResult = InputB(bFileSize, iFN)
    Dim arrFind() As Byte
    '要查找的字节串,"/Count"为pdf总页数的特征字符标识
    arrFind = VBA.StrConv("/Count", vbFromUnicode)
    '设置查找的起始位置
    bPos = 0
    bPos = VBA.InStrB(bPos + 1, arrResult, arrFind, vbBinaryCompare)
    '设置个变量预装"/Count"之后的字符
    Dim sResult As String
    sResult = Space(1000)
    Get iFN, bPos + 6, sResult
    GetPageNum = VBA.Val(sResult)
    Close iFN
End Function

以下代码是列举任意文件夹下的所有pdf文件的总页数的：

Sub QQ1722187970()
    MsgBox "请选择要获取pdf文件的总页数的文件夹"
    sPath = GetPath()
    If Len(sPath) Then
        Call EnuAllFiles(sPath)
        MsgBox "执行完毕!!!"
    End If
End Sub
Function GetPath() As String
    '声明一个FileDialog对象变量
    Dim oFD As FileDialog
'    '创建一个选择文件对话框
'    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    '创建一个选择文件夹对话框
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    '声明一个变量用来存储选择的文件名
    Dim vrtSelectedItem As Variant
    With oFD
        '允许选择多个文件
        .AllowMultiSelect = True
        '使用Show方法显示对话框，如果单击了确定按钮则返回-1。
        If .Show = -1 Then
            '遍历所有选择的文件
            For Each vrtSelectedItem In .SelectedItems
                '获取所有选择的文件的完整路径,用于各种操作
                GetPath = vrtSelectedItem
            Next
            '如果单击了取消按钮则返回0
        Else
        End If
    End With
    '释放对象变量
    Set oFD = Nothing
End Function
Function GetPageNum(ByVal sPath As String)
    Dim iFN As Integer
    iFN = VBA.FreeFile
    Dim bFileSize As Long
    bFileSize = VBA.FileLen(sPath)
    Open sPath For Binary Access Read As iFN
    Dim arrResult() As Byte
    '读取字节流
    arrResult = InputB(bFileSize, iFN)
    Dim arrFind() As Byte
    '要查找的字节串,"/Count"为pdf总页数的特征字符标识
    arrFind = VBA.StrConv("/Count", vbFromUnicode)
    '设置查找的起始位置
    bPos = 0
    bPos = VBA.InStrB(bPos + 1, arrResult, arrFind, vbBinaryCompare)
    '设置个变量预装"/Count"之后的字符
    Dim sResult As String
    sResult = Space(1000)
    Get iFN, bPos + 6, sResult
    GetPageNum = VBA.Val(sResult)
    Close iFN
End Function
Sub EnuAllFiles(ByVal sPath As String, Optional ByVal bEnuSub As Boolean = False)
    Dim oWK As Worksheet
    Set oWK = Sheet5
    With oWK
        .Cells.Clear
        .Range("a1:b1") = Array("文件名", "总页数")
        iRow = .Range("a65536").End(xlUp).Row + 1
    End With
    '定义文件系统对象
    Dim oFso As Object
    Set oFso = CreateObject("Scripting.FileSystemObject")
    '定义文件夹对象
    Dim oFolder As Object
    Set oFolder = oFso.GetFolder(sPath)
    '定义文件对象
    Dim oFile As Object
    '如果指定的文件夹含有文件
    If oFolder.Files.Count Then
        For Each oFile In oFolder.Files
            With oFile
                '输出文件所在的盘符
                Dim sDrive As String
                sDrive = .Drive
                '输出文件的类型
                Dim sType As String
                sType = .Type
                '输出含后缀名的文件名称
                Dim sName As String
                sName = .Name
                '输出含文件名的完整路径
                Dim sFilePath As String
                sFilePath = .Path
                '如果文件是Word文件
                If sType Like "*Acrobat*" Then
                    iPageNum = GetPageNum(sFilePath)
                    With oWK
                        .Cells(iRow, 1) = sName
                        .Cells(iRow, 2) = iPageNum
                        iRow = iRow + 1
                    End With
                Else
                End If
            End With
        Next
    '如果指定的文件夹不含有文件
    Else
    End If
    '如果要遍历子文件夹
    If bEnuSub = True Then
        '定义子文件夹集合对象
        Dim oSubFolders As Object
        Set oSubFolders = oFolder.SubFolders
        If oSubFolders.Count > 0 Then
            For Each oTempFolder In oSubFolders
                sTempPath = oTempFolder.Path
                Call EnuAllFiles(sTempPath, True)
            Next
        End If
        Set oSubFolders = Nothing
    End If
    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFso = Nothing
End Sub