PDFファイルのページ数を取得する

' PDFページ数取得関数のテストプロシージャ

'----------------------------------------------------------------
’呼び出すプロシージャ
'----------------------------------------------------------------
Sub prcTestGetPDFPageCount()
    Dim strPDFPath As String ' テスト対象のPDFファイルパス
    Dim lngPageCount As Long ' 取得したページ数
    
    ' PDFファイルのパスを指定
    strPDFPath = "C:\path\to\your\file.pdf" ' 実際のパスに書き換えてください
    
    ' ページ数を取得
    lngPageCount = fncGetPDFPageCount(strPDFPath)
    
    ' ページ数を表示
    MsgBox "PDFページ数: " & lngPageCount, vbInformation, "結果"
End Sub

'----------------------------------------------------------------
' PDFファイルのページ数を取得する
関数
'----------------------------------------------------------------
Function fncGetPDFPageCount(ByVal strPath As String) As Long
    Dim strPDFSourceText As String ' PDFソーステキスト
    Dim objRegExpMatchCollection As Object ' 正規表現マッチコレクション
    Dim objRegExpMatch As Object ' 正規表現マッチオブジェクト
    Dim objStream As Object ' ADODB.Streamオブジェクト
    Dim objRegExp As Object ' VBScript.RegExpオブジェクト
    
    On Error GoTo ErrorHandler
    
    ' ADODB.Streamオブジェクトの初期化
    Set objStream = CreateObject("ADODB.Stream")
    With objStream
        .Charset = "UTF-8"
        .Open
        .LoadFromFile strPath
        strPDFSourceText = .ReadText
        .Close
    End With
    Set objStream = Nothing ' ストリームオブジェクトの解放
    
    ' VBScript.RegExpオブジェクトの初期化
    Set objRegExp = CreateObject("VBScript.RegExp")
    With objRegExp
        .Pattern = "(/Count\s+)\d+"
        .MultiLine = True
        Set objRegExpMatchCollection = .Execute(strPDFSourceText)
        If objRegExpMatchCollection.Count > 0 Then
            Set objRegExpMatch = objRegExpMatchCollection.Item(0)
            fncGetPDFPageCount = CLng(Val(Mid(objRegExpMatch.Value, Len("/Count ") + 1)))
        Else
            fncGetPDFPageCount = -1 ' マッチする項目がない場合
        End If
    End With
    Set objRegExp = Nothing ' RegExpオブジェクトの解放
    Exit Function

ErrorHandler:
    fncGetPDFPageCount = -1 ' エラー処理
    Set objStream = Nothing ' エラー発生時もストリームオブジェクトを解放
    Set objRegExp = Nothing ' エラー発生時もRegExpオブジェクトを解放
End Function

コメント