Poppler:PDFの添付ファイル一覧を取得するVBA関数

TOP > Poppler ツール > *


P.Vongsuri_7028246

概要

PDFの添付ファイルの数とファイル名を取得します。

Acrobat OLE を使わずに Poppler の pdfdetach.exe を使用します。

  1. 事前に各種エラーチェック
  2. 「-list」オプションでPDFの添付ファイル数を確認する。
    ゼロ件の時は以降の処理をスキップする。
  3. 添付ファイルのファイル名一覧を抽出する。

Poppler とは

フリーソフト Poppler を知らない人は先にコチラを御覧ください。

形式

001 Public Sub popListEembeddedFiles( _ 002 ByVal popPara_InPdfPath As String, _ 003 ByVal popPara_InPdfPassword As String, _ 004 ByRef popPara_OutFileName() As String, _ 005 ByRef popPara_FileCount As Long, _ 006 ByRef strCmdMsg() As String, _ 007 ByRef strErr As String)


 Highlight:プログラミング言語のソースコードを構文で色分け (GUI編)
 

引数

  1. 第1引数 : popPara_InPdfPath As String  (In)
    入力のPDFファイルのフルパス
  2. 第2引数 : popPara_InPdfPassword As String  (In)
    入力のPDFファイルのユーザーパスワード。無ければ""。
  3. 第3引数 : popPara_OutFileName() As String (Out)
    添付ファイルのファイル名
  4. 第4引数 : popPara_FileCount As Long  (Out)
    添付ファイルのファイル数
  5. 第5引数 : strCmdMsg() As String  (Out)
    コマンドラインで表示された内容

     

    • strCmdMsg(0) : 標準出力
    • strCmdMsg(1) : 標準エラー出力
  6. 第6引数 : strErr As String  (Out)
    プログラム内のエラーメッセージ。エラー無しは ""。

戻り値

無し。

関数 / サンプル

事前設定

  1. コチラを参考にPoppler のダウンロードとインストールを行う。
  2. pdfdetach.exe のフルパスをCON_POPPLER_PATHにセット。
  3. gDebugMode = True のデバッグモードをFalseにセット。

サンプル

  • A-de-007.pdf から添付ファイルの数とファイル一覧を取得します。
  • A-de-007.pdf のユーザーパスワードは「def」です。

DownloadcLine-popListEembeddedFiles.xls

001 Option Explicit 002 003 Declare Function WaitForSingleObject Lib "kernel32" _ 004 (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long 005 Declare Function CloseHandle Lib "kernel32" _ 006 (ByVal hObject As Long) As Long 007 Declare Function GetExitCodeProcess Lib "kernel32" _ 008 (ByVal hProcess As Long, lpExitCode As Long) As Long 009 Declare Function OpenProcess Lib "kernel32" _ 010 (ByVal dwDesiredAccess As Long, _ 011 ByVal bInheritHandle As Long, _ 012 ByVal dwProcessID As Long) As Long 013 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 014 015 Const SYNCHRONIZE = 1048576 016 Const PROCESS_QUERY_INFORMATION = &H400 017 018 'Poppler-0.45 pdfdetach.exe 019 Const CON_POPPLER_PATH = "I:¥Tools¥Poppler-0.45¥bin¥pdfdetach.exe" 020 ' Teme File No 021 Private gFileCnt As Long 022 ' Debug Mode [ True=On | False=Off ] 023 Private gDebugMode As Boolean 024 Private Const CON_FOLDER_KUGIRI = "¥" 025 026 ' テスト用 メイン呼び出しSub 027 028 Sub Main_Demo() 029 gDebugMode = True '実運用ではFalse 030 031 Dim popPara_InPdfPath As String 032 Dim popPara_InPdfPassword As String 033 Dim popPara_OutFileName() As String 034 Dim popPara_FileCount As Long 035 'pdfdetach.exe コマンドラインからの出力内容 036 Dim strCmdMsg(1) As String 037 '関数内の実行エラー時のエラーメッセージ 038 Dim strErr As String 039 040 Dim i As Long 041 042 '初期化 043 For i = 0 To UBound(strCmdMsg) 044 strCmdMsg(i) = "" 045 Next i 046 047 If gDebugMode Then Debug.Print "Start:" & Now 048 ' Dim j As Long 049 ' For j = 0 To **** 050 051 '入力PDFのフルパス 052 popPara_InPdfPath = Application.ActiveWorkbook.Path & _ 053 CON_FOLDER_KUGIRI & "A-de-007.pdf" 054 '入力PDFの(文書を開く時の)ユーザーパスワード 055 popPara_InPdfPassword = "def" 056 057 '関数の呼び出し 058 strErr = "" 059 Call popListEembeddedFiles( _ 060 popPara_InPdfPath, popPara_InPdfPassword, _ 061 popPara_OutFileName(), _ 062 popPara_FileCount, strCmdMsg(), strErr) 063 064 '関数の結果を確認 065 If InStr(strCmdMsg(0), "0 embedded files") > 0 Then 066 '「-list」オプションで添付ファイル数でゼロ件が返された時 067 MsgBox popPara_InPdfPath & vbCrLf & vbCrLf & _ 068 "添付ファイルが存在しませんでした。" & _ 069 vbCrLf & strCmdMsg(0), vbInformation, "お知らせ" 070 Exit Sub 071 ElseIf strErr <> "" Then 072 '関数内のプラグラムでエラーが発生した時 073 MsgBox strErr & vbCrLf & vbCrLf & _ 074 strCmdMsg(0) & vbCrLf & strCmdMsg(1), _ 075 vbCritical, "プログラム内の実行エラー" 076 Exit Sub 077 ElseIf strCmdMsg(1) <> "" Then 078 'コマンドラインの実行時にエラーを返された時 079 MsgBox strCmdMsg(1), _ 080 vbCritical, "コマンドラインの実行エラー" 081 Exit Sub 082 End If 083 084 '添付ファイルが保存できた。正常終了 085 Dim sWkMsg As String 086 sWkMsg = "添付ファイルの数=" & popPara_FileCount 087 For i = 0 To UBound(popPara_OutFileName) 088 sWkMsg = sWkMsg & vbCrLf & _ 089 (i + 1) & "=" & popPara_OutFileName(i) 090 Next i 091 092 '※正常ならばローカルに保存した添付ファイルを別フォルダに移動する。 093 'name 094 'FileCopy 095 'FileSystemObject 等を使う 096 097 ' Next j 098 If gDebugMode Then Debug.Print "End :" & Now 099 100 MsgBox sWkMsg, vbInformation, "終了" 101 ' MsgBox "strCmdMsg(0)=" & strCmdMsg(0) & vbCrLf & _ 102 ' "strCmdMsg(1)=" & strCmdMsg(1) & vbCrLf & _ 103 ' "strErr=" & strErr, vbInformation, "正常終了" 104 End Sub 105 106 '************************************************** 107 ' 108 ' List all of the embedded files from the PDF file. 109 ' 110 ' 機能 : Poppler pdfdetach.exeを使って添付ファイルの 111 ' 数とファイル名の一覧を取得します。 112 ' Create : 2016/07/02 113 ' Update : 2016/07/02 114 ' Vertion : 1.0.0 115 ' 116 ' 第1引数:popPara_InPdfPath As String (In) 117 ' 入力のPDFファイルのフルパス 118 ' 第2引数:popPara_InPdfPassword As String (In) 119 ' 入力のPDFファイルのユーザーパスワード。無ければ""。 120 ' 第3引数:popPara_OutFileName() As String (Out) 121 ' 添付ファイルのファイル名 122 ' 第4引数:popPara_FileCount As Long (Out) 123 ' 添付ファイルのファイル数 124 ' 第5引数:strCmdMsg() As String (Out) 125 ' コマンドラインで表示された内容 126 ' strCmdMsg(0):標準出力 127 ' strCmdMsg(1):標準エラー出力 128 ' 第6引数:strErr As String (Out) 129 ' プログラム内のエラーメッセージ。エラー無しは ""。 130 ' 戻り値 : 無し 131 ' 132 ' 備考 : strErr<>""の時はエラー扱いとする。 133 ' URL : http://pdf-file.nnn2.com?p=876 134 ' その他 : 著作権等は主張しません。 135 ' 上記URLにコメントを頂けると嬉しいです。 136 ' 137 '************************************************** 138 139 Public Sub popListEembeddedFiles( _ 140 ByVal popPara_InPdfPath As String, _ 141 ByVal popPara_InPdfPassword As String, _ 142 ByRef popPara_OutFileName() As String, _ 143 ByRef popPara_FileCount As Long, _ 144 ByRef strCmdMsg() As String, _ 145 ByRef strErr As String) 146 147 On Error GoTo Err_popListEembeddedFiles: 148 149 Dim strFilePath As String 150 Dim strTempFilePath(1) As String 151 Dim strCmd As String 152 Dim objFileSystem As Object 153 Dim i As Long 154 155 Const CON_OPTION_LIST = " -list " 156 157 '初期化 158 Set objFileSystem = CreateObject("Scripting.FileSystemObject") 159 strErr = "" 160 popPara_FileCount = 0 161 162 'エラーチェック 163 If objFileSystem.FileExists(popPara_InPdfPath) = False Then 164 strErr = popPara_InPdfPath & vbCrLf & _ 165 "[E01]このファイルは存在しません。" 166 Exit Sub 167 End If 168 If objFileSystem.FileExists(CON_POPPLER_PATH) = False Then 169 strErr = CON_POPPLER_PATH & vbCrLf & _ 170 "[E04]このファイルは存在しません" 171 Exit Sub 172 End If 173 174 '▼コマンドラインの編集(-list) 175 strCmd = CON_POPPLER_PATH & CON_OPTION_LIST 176 If popPara_InPdfPassword <> "" Then 177 'ユーザーパスワードをセット 178 strCmd = strCmd & "-upw " & popPara_InPdfPassword & " " 179 End If 180 181 '一時ファイル 182 gFileCnt = gFileCnt + 1 183 strFilePath = _ 184 Application.ActiveWorkbook.Path & CON_FOLDER_KUGIRI & _ 185 Format(Now(), "yyyymmdd-hhmmss-") & gFileCnt 186 ' 標準出力用 187 strTempFilePath(0) = strFilePath & ".txt" 188 ' 標準エラー出力用 189 strTempFilePath(1) = strFilePath & "-err.txt" 190 191 '注意:ファイルパスの前後にダブルクォーテーション 192 strCmd = strCmd & _ 193 """" & popPara_InPdfPath & _ 194 """ > """ & strTempFilePath(0) & _ 195 """ 2> """ & strTempFilePath(1) & """" 196 197 'コマンドラインの実行 198 strCmd = "cmd /c " & strCmd 199 Call RunCommandLine(strCmd, strErr) 200 If gDebugMode Then Debug.Print strCmd 201 ' If strErr <> "" Then 202 ' 'コマンドラインでエラー有り 203 ' GoTo popListEembeddedFiles_Skip: 204 ' End If 205 206 On Error GoTo popListEembeddedFiles_Skip: 207 208 '標準出力のテキストを読み込む 209 Call InputTempFile(strTempFilePath(), strCmdMsg(), strErr) 210 If strCmdMsg(1) <> "" Or strErr <> "" Then 211 'コマンドラインでエラー有り 212 GoTo popListEembeddedFiles_Skip: 213 End If 214 215 'コマンドラインでエラー無し 216 217 '▼添付ファイルのファイル名を取得 218 Dim strWk1 219 Dim strWk2 220 Dim bWk() As Byte 221 222 strWk1 = Split(strCmdMsg(0), vbCrLf) 223 '添付ファイルの数を取得 1行目:"x embedded files" 224 strWk2 = Split(strWk1(0), " ") 225 popPara_FileCount = strWk2(0) 226 If popPara_FileCount = 0 Or strWk2(1) <> "embedded" Then 227 '添付ファイル=ゼロ件、又はエラーはスキップ 228 GoTo popListEembeddedFiles_Skip: 229 End If 230 231 'ファイル名の抽出 232 ReDim popPara_OutFileName(popPara_FileCount - 1) As String 233 Dim strANSI As String 234 Dim bHenkan() As Boolean 235 ReDim bHenkan(popPara_FileCount - 1) As Boolean 236 Dim lHenkanCnt As Long 237 238 lHenkanCnt = 0 239 For i = 0 To popPara_FileCount - 1 240 strWk2 = Split(strWk1(i + 1), " ") 241 popPara_OutFileName(i) = strWk2(1) 242 'ファイル名に2バイト文字が存在するかをチェック 243 strANSI = StrConv(popPara_OutFileName(i), vbFromUnicode) 244 If Len(popPara_OutFileName(i)) <> LenB(strANSI) Then 245 '全角文字(2バイト文字)が混ざっている 246 bHenkan(i) = True 247 lHenkanCnt = lHenkanCnt + 1 248 Else 249 '半角文字のみ 250 bHenkan(i) = False 251 End If 252 Next i 253 254 popListEembeddedFiles_Skip: 255 Set objFileSystem = Nothing 256 Exit Sub 257 Err_popListEembeddedFiles: 258 strErr = "(popListEembeddedFiles) Runtime Error :" & _ 259 Err.Number & vbCrLf & Err.Description & vbCrLf & _ 260 vbCrLf & "PDF File=" & popPara_InPdfPath 261 End Sub 262 263 ' コマンドラインの標準出力と標準エラー出力の 264 ' テキストファイルを読み込む。 265 ' UTF-8なのでADODB.Streamを使って変換しながら読み込む。 266 267 Sub InputTempFile( _ 268 ByRef strTempFilePath() As String, _ 269 ByRef strCmdMsg() As String, _ 270 ByRef strErr As String) 271 On Error GoTo Err_InputTempFile: 272 273 Dim strInput As String 274 Dim lFileNo As Long 275 Dim i As Long 276 277 Dim strBuff As String 278 Dim objStream As Object 279 280 For i = 0 To UBound(strTempFilePath) 281 'UTF-8のファイルを読み込む 282 Set objStream = CreateObject("ADODB.Stream") 283 With objStream 284 .Charset = "UTF-8" 285 .Type = 2 '(1:バイナリ 2:テキスト) 286 .Open 287 .LoadFromFile strTempFilePath(i) 288 strBuff = .ReadText 289 .Close 290 End With 291 Set objStream = Nothing 292 293 strCmdMsg(i) = strBuff 294 Next i 295 296 '一時ファイルの削除 297 If strErr = "" Then 298 For i = 0 To UBound(strTempFilePath) 299 Kill strTempFilePath(i) 300 Next i 301 End If 302 Exit Sub 303 Err_InputTempFile: 304 strErr = "(InputTempFile) Runtime Error :" & _ 305 Err.Number & vbCrLf & Err.Description 306 End Sub 307 308 ' shell 関数の終了を待つ 309 310 Sub RunCommandLine(ByVal strCmd As String, _ 311 ByRef strErr As String) 312 On Error GoTo Err_RunCommandLine: 313 314 Dim hProcess As Long 315 Dim lpdwExitCode As Long 316 Dim dwProcessID As Long 317 Dim lRet As Long 318 Dim lCnt As Long 319 Const CON_SLEEP = 20 320 Const CON_LOOP_CNT = 250 321 lCnt = 0 322 dwProcessID = Shell(strCmd, vbHide) 323 hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, _ 324 True, dwProcessID) 325 Do 326 Sleep CON_SLEEP 327 DoEvents 328 lRet = GetExitCodeProcess(hProcess, lpdwExitCode) 329 lCnt = lCnt + 1 330 If lCnt > CON_LOOP_CNT Then 331 If gDebugMode Then Debug.Print vbCrLf & strCmd 332 strErr = "[RunCommandLine]Shell Error : Time Orver " & _ 333 CON_SLEEP * CON_LOOP_CNT & "ms" 334 Exit Sub 335 End If 336 Loop While lpdwExitCode <> 0 337 Exit Sub 338 Err_RunCommandLine: 339 strErr = "(RunCommandLine) Runtime Error :" & _ 340 Err.Number & vbCrLf & Err.Description & vbCrLf & _ 341 vbCrLf & "Command=" & strCmd 342 End Sub


 Highlight:プログラミング言語のソースコードを構文で色分け (GUI編)
 

結果

001 Start:2016/07/02 6:57:15 002 cmd /c ・・・長いので省略・・・ -list  ・・・長いので省略・・・・ 003 End :2016/07/02 6:57:16

▽正常終了の時

Poppler:PDFの添付ファイル一覧を取得するVBA関数

上記は関数内で編集したメッセージです。

▽ユーザーパスワードが間違っている時

Poppler:PDFの添付ファイル一覧を取得するVBA関数

上記の1段目はプログラム内からのエラーメッセージ。2段目はコマンドラインからのエラーメッセージです。

▽添付ファイルがゼロ件の時

Poppler:PDFの添付ファイル一覧を取得するVBA関数

上記は1段目と2段目はプラグラム内で編集したメッセージです。3段目がコマンドラインからのメッセージです。

結果の判断方法

popListEembeddedFiles 関数の戻り値で判断します。以下は優先順位を含めて解説します。

  1. 添付ファイル数でゼロ件が返された時:
    InStr(strCmdMsg(0), "0 embedded files") > 0 の時です。
    strCmdMsg(0)には改行コードも入っているので
    strCmdMsg(0) = "0 embedded files" の判定は出来ない。
  2. 関数内のプラグラムでエラーが発生した時:
    strErr <> "" の時です。
  3. コマンドラインの実行時にエラーを返された時:
    strCmdMsg(1) <> "" の時です。

詳細はサンプル内の「Sub Main_Demo 」のpopListEembeddedFiles 関数使用後の処理コードを参照してください。

001 '関数の結果を確認 002 If InStr(strCmdMsg(0), "0 embedded files") > 0 Then 003 '「-list」オプションで添付ファイル数でゼロ件が返された時 004 MsgBox popPara_InPdfPath & vbCrLf & vbCrLf & _ 005 "添付ファイルが存在しませんでした。" & _ 006 vbCrLf & strCmdMsg(0), vbInformation, "お知らせ" 007 Exit Sub 008 ElseIf strErr <> "" Then 009 '関数内のプラグラムでエラーが発生した時 010 MsgBox strErr & vbCrLf & vbCrLf & _ 011 strCmdMsg(0) & vbCrLf & strCmdMsg(1), _ 012 vbCritical, "プログラム内の実行エラー" 013 Exit Sub 014 ElseIf strCmdMsg(1) <> "" Then 015 'コマンドラインの実行時にエラーを返された時 016 MsgBox strCmdMsg(1), _ 017 vbCritical, "コマンドラインの実行エラー" 018 Exit Sub 019 End If 020 021 '添付ファイルが保存できた。正常終了


 Highlight:プログラミング言語のソースコードを構文で色分け (GUI編)
 

PDFの添付ファイル

  1. POPPLER:PDFの添付ファイルを保存するVBA関数
  2. PDF の3つのパスワード  ※添付ファイルのパスワードの話

備考

  1. 関数の以下の引数は配列数を宣言してないことに注意。
    関数内でReDim で再宣言するからです。

     

    • Dim popPara_OutFileName()   As String
  2. コマンドラインの標準出力のテキストがUTF-8の為に日本語文字が化けてしまいます。その為のやや複雑な処理が入っています。
  3. この pdfdetach.exe は日本語の扱いが現在は出来ません。VBA関数で操作すると日本語の問題をカバーできるので、かえってこちらのVBA関数の方が便利だと思います。

< Poppler へ戻る


技術メモ

これ以降は当関数に関する作成者の技術メモです。見なくても結構です。後のメンテナンスの時に見ます。

基本

  1. Poppler も Xpdf も pdfdetach.exe の技術仕様は基本的に同じのはずです。
  2. 日本語名の添付ファイルを pdfdetach.exe で表示するとファイル名は文字化けを起こします。Xpdf では日本語の言語ファイルが有るので「-enc Shif-JIS」オプションで日本語は扱えますがファイル名は全て「全角文字」になってしまいます。Poppler であろうと Xpdf であろうと日本語を意識するとファイル名の扱いにどうしようもなく対応に困る問題が出ます。しかし、当関数はその問題を全て解決する様に処理を行っています。半角文字は半角で、全角文字は全角でファイル名を処理しています。

標準出力と標準エラー出力について

  1. コマンドラインでの結果を標準出力と標準エラー出力の2つのテキストに出力できます。標準出力は正常の結果内容。標準エラー出力はエラー時のメッセージ内容。たまに逆に出力しているプログラムの有りますが、一応はこの形です。
  2. pdfdetach.exe で「-list」オプションを実行してます。この時は標準出力があって、標準出力エラーが無い時が正常終了を意味してます。
  3. 標準出力と標準エラー出力共にUTF-8のコードでテキストに出力します。よってVBAで読み込む時は変換して読み込む必要が有ります。つまりVBAの通常のテキスト入力ではダメです。

エラーメッセージの扱い

  1. 当VBA関数でのエラーの判定は優先順位:上が高、下が低。
    1. strErr : VBA関数内でのエラーの内容
    2. strCmdMsg( 1 ) : コマンドラインの標準エラー出力の内容
    3. strCmdMsg( 0 ) : コマンドラインの標準出力の内容
  2. 上記ではstrCmdMsg( 0 )の内容も見る必要があります。理由は添付ファイルを保存する前「-list」オプションを実行し、strCmdMsg( 0 )=「0 embedded files」でないかをチェックする必要があるからです。
  3. strErr も strCmdMsg( 1 ) もブランクの時は正常処理。
  4. 詳細はVBA関数のサンプル「Sub Main_demo」を参照。

< Poppler へ戻る

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

CAPTCHA


★ 文章での質問は難しいですよネ。でも、早く解決して、家に帰りたい。


SAMURAI Plugin

コメントをする時は出来れば以下もお願いします。

  • OS名 バージョン
  • Acrobat バージョン
  • ツール(Excel等) バージョン
コメントにサンプルコードを入れる時はコードを全て全角文字列にしてください。コチラで半角に戻します。それでもエラーが回避できない時はコメント下さい。個別に対処します。



お仕事で当サイトを見ている方へ
考え込んだら、ご質問下さい。
一緒に解決策を考えましょう。

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください