’呼び出し側の処理
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
コメント