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

TOP > Poppler ツール > *

概要

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

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

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

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編)
　

引数

第１引数： popPara_InPdfPath As String (In)
入力のPDFファイルのフルパス
第２引数： popPara_InPdfPassword As String (In)
入力のPDFファイルのユーザーパスワード。無ければ""。
第３引数： popPara_OutFileName() As String (Out)
添付ファイルのファイル名
第４引数： popPara_FileCount As Long (Out)
添付ファイルのファイル数
第５引数： strCmdMsg() As String (Out)
コマンドラインで表示された内容
- strCmdMsg(0) ：標準出力
- strCmdMsg(1) ：標準エラー出力
第６引数： strErr As String (Out)
プログラム内のエラーメッセージ。エラー無しは ""。

戻り値

無し。

関数 / サンプル

事前設定

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

サンプル

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

Download：cLine-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 ' 第１引数：popPara_InPdfPath As String  (In)
117 '           入力のPDFファイルのフルパス
118 ' 第２引数：popPara_InPdfPassword As String  (In)
119 '           入力のPDFファイルのユーザーパスワード。無ければ""。
120 ' 第３引数：popPara_OutFileName() As String (Out)
121 '           添付ファイルのファイル名
122 ' 第４引数：popPara_FileCount As Long  (Out)
123 '           添付ファイルのファイル数
124 ' 第５引数：strCmdMsg() As String  (Out)
125 '           コマンドラインで表示された内容
126 '           strCmdMsg(0)：標準出力
127 '           strCmdMsg(1)：標準エラー出力
128 ' 第６引数：strErr As String  (Out)
129 '           プログラム内のエラーメッセージ。エラー無しは ""。
130 ' 戻り値  : 無し
131 '
132 ' 備考    : strErr<>""の時はエラー扱いとする。
133 ' URL     : https://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     '添付ファイルの数を取得   １行目："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         'ファイル名に２バイト文字が存在するかをチェック
243         strANSI = StrConv(popPara_OutFileName(i), vbFromUnicode)
244         If Len(popPara_OutFileName(i)) <> LenB(strANSI) Then
245             '全角文字（２バイト文字）が混ざっている
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

▽正常終了の時

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

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

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

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

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

結果の判断方法

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

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

POPPLER：PDFの添付ファイルを保存するVBA関数
PDF の３つのパスワード ※添付ファイルのパスワードの話

備考

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

＜　Poppler へ戻る＞

技術メモ

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

基本

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

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

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

エラーメッセージの扱い

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

＜　Poppler へ戻る＞

PDF

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

概要

Poppler とは

形式

引数

戻り値

関数 / サンプル

事前設定

サンプル

結果

結果の判断方法

PDFの添付ファイル

備考

技術メモ

基本

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

エラーメッセージの扱い

コメントを残す

VBA(Excel)からAcrobat経由でPDFをプログラミング操作(OLE:IAC)する