PDFのページ数を取得(PDF側に特定できる文字が存在する場合)

’呼び出し側の処理
Sub prcTestGetPDFPageCountInFolder()
    Dim strFolder As String
    Dim strFile As String
    Dim lngPageCount As Long
    Dim ws As Worksheet
    Dim lngRow As Long
    
    ' 出力対象のワークシートを設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    ' 出力開始行
    lngRow = 1
    
    ' PDFファイルが格納されているフォルダのパス
    strFolder = "C:\path\to\your\pdf\folder\" ' 実際のフォルダパスに置き換えてください
    
    ' フォルダ内の最初のPDFファイルを取得
    strFile = Dir(strFolder & "*.pdf")
    
    ' フォルダ内の全PDFファイルに対してループ
    Do While strFile <> ""
        ' ページ数を取得
        lngPageCount = fncGetPDFPageCountSimple(strFolder & strFile)
        
        ' ファイル名をA列に、ページ数をB列に出力
        With ws
            .Cells(lngRow, 1).Value = strFile
            .Cells(lngRow, 2).Value = lngPageCount
        End With
        lngRow = lngRow + 1
        
        ' 次のファイルを取得
        strFile = Dir()
    Loop
End Sub
'----------------------------------------------------------------
’PDFページ数を取得する関数
Function fncGetPDFPageCountSimple(ByVal strPath As String) As Long
    Dim strPDFSourceText As String
    Dim startPos As Long
    Dim endPos As Long
    Dim pageCountStr As String
    Dim pageCount As Long
    
    ' PDFファイルからテキストを読み込む
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8"
        .Open
        .LoadFromFile strPath
        strPDFSourceText = .ReadText
        .Close
    End With
    
    ' "/Count "文字列の位置を探す
    startPos = InStr(strPDFSourceText, "/Count ")
    
    If startPos > 0 Then
        ' 数字が始まる位置を見つける("/Count "の長さを足す)
        startPos = startPos + Len("/Count ")
        
        ' 数字の部分を抽出(この例では最大10文字とする)
        pageCountStr = Mid(strPDFSourceText, startPos, 10)
        
        ' 抽出した文字列から数値を取得
        pageCount = Val(pageCountStr)
        
        ' 数値を返す
        fncGetPDFPageCountSimple = pageCount
    Else
        ' "/Count "が見つからない場合は-1を返す
        fncGetPDFPageCountSimple = -1
    End If
End Function
'----------------------------------------------------------------
’こちらは正規表現を使用するパターン
Function fncGetPDFPageCount(ByVal strPath As String) As Long
    ' PDFファイルのテキストを格納する変数
    Dim strPDFSourceText As String
    ' 正規表現を使用するためのオブジェクト変数
    Dim objRegExp As Object
    ' マッチコレクションを格納する変数
    Dim objMatches As Object
    
    ' ADODB.Streamオブジェクトを使用してPDFファイルからテキストを読み込む
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8" ' 文字コードをUTF-8に設定
        .Open ' ストリームを開く
        .LoadFromFile strPath ' 指定されたパスのファイルを読み込む
        strPDFSourceText = .ReadText ' テキストとして内容を読み込む
        .Close ' ストリームを閉じる
    End With
    
    ' 正規表現オブジェクトの初期化
    Set objRegExp = CreateObject("VBScript.RegExp")
    With objRegExp
        .Global = True ' グローバルマッチを行う(テキスト全体を対象にする)
        .MultiLine = True ' 複数行にわたる検索を可能にする
        .IgnoreCase = True ' 大文字と小文字を区別しない
        ' ページ数を示す部分のパターン。"/Count"に続く1つ以上の空白と数字にマッチする
        .Pattern = "/Count\s+\d+"
    End With
    
    ' テキスト内で正規表現に一致する部分を検索
    Set objMatches = objRegExp.Execute(strPDFSourceText)
    
    ' 一致する部分が見つかった場合はその数値を取得し、Long型で返す
    If objMatches.Count > 0 Then
        ' マッチしたテキストから数字部分(ページ数)を抽出して返す
        fncGetPDFPageCount = CLng(Val(Mid(objMatches(0).Value, Len("/Count ") + 1)))
    Else
        ' マッチするものがない場合は-1を返す
        fncGetPDFPageCount = -1
    End If
End Function

コメント