' 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
コメント