関数：PDFからメタデータ(XMP)を抽出する

TOP > サンプル/関数 > 関数：PDFからメタデータ(XMP)を抽出する […]

概要

PDFファイルには文書に関する詳細な情報を明記したメタデータ(XMP)がML形式で入っています。

それをXML形式でテキスト抽出します。

抽出したXMLから、要素名での値の抽出も行います。

お知らせ
以下のコマンドラインツールからでもメタデータ(XMP)は取得できます。
ライセンス上の問題が無ければ、そちらの方をオススメします。

Poppler(Pdfinfo) : PDFのコマンドラインツール　＜ーイチオシ！
CPDF：メッチャ多機能なPDFのコマンドライン・ツール

理由：機能的に上記の方がはるかに優れています。また将来的な事を考えると色々な面で有利になると考えています。ライセンスが難しい時は当ページの関数をお使いください。

機能

以下の２つの関数で連携して、機能を提供します。

A. 関数名： Get_XML_nnn2

PDFファイルをテキスト形式で読み込みます。
PDFファイルはUTF-8 なのでコード変換して読み込みます。
メタデータはPDFが更新されるたびに新しいのが後ろに追加されます。
PDFファイルの更新日時情報と一致するメタデータのみを検索します。
※最適化時に古いのは削除される？
メタデータはXML形式で登録されているので、要素名[x:xmpmeta]で検索します。
該当するメタデータが見つかった時に、その内容をXMLのテキストで抽出します。

B. 関数名： Get_XML_Node_nnn2

抽出したテキストのXMLからメタデータの形式にしたがって、要素名に該当する値を抽出します。

制限、注意事項

パスワード保護によりメタ情報が暗号化されているPDFファイルからは
メタデータの抽出は出来ません。
PDFファイル全体をメモリ内に一括で読み込みます。よって、２０Mバイトのファイルにもなると実行中にも関わらず、停止しているかのように感じます。ご注意ください。
メタデータのXML内容については十分に調査していないので、問題等があった場合にはコメントで頂けると助かります。ただし、対応出来るかの保証は全く無いです。

Get_XML_nnn2

形式

001 [Long] = Get_XML_nnn2 ( 
002     string sFilePath ,  
003     string sGetXml , 
004     string sMsg )

引数

第一引数 ( string sFilePath ) : In
PDF ファイルのフルパス
第二引数 ( string sGetXml ) : Out
取得したXML形式のメタデータ
第三引数 ( string sMsg ) : Out
処理結果のメッセージ
エラーメッセージも含む

戻り値

0 : 正常処理
1 以上 : エラーが発生した
エラーの詳細は第３引数 sMsg にセットされる

Get_XML_Node_nnn2

形式

001 [string] = Get_XML_Node_nnn2 ( 
002     string sXml ,  
003     string sNodeName )

引数

第一引数 ( string sXml ) :
XML形式のメタデータ
第二引数 ( string sNodeName ) :
検索する要素名

戻り値

""以外 : 正常処理。要素名に該当する値がセットされる。
”” : 検索したノードデータが存在しない、値が無い、又はエラーが発生。

サンプル

事前に以下の参照設定を行う

Download：sample-GetPdfMetaData.xls

001 Option Explicit
002 
003 'x1. 取得できたPDFのOLE(IAC)情報
004 Private msGetInfo_Title         As String
005 Private msGetInfo_Author        As String
006 Private msGetInfo_Subject       As String
007 Private msGetInfo_Keywords      As String
008 Private msGetInfo_Creator       As String
009 Private msGetInfo_Producer      As String
010 Private msGetInfo_CreationDate  As String
011 Private msGetInfo_ModDate       As String
012 Private msGetInfo_Trapped       As String
013 Private msGet_GetPermanentID    As String
014 Private msGet_FileName          As String
015 Private mbGet_DeletPage         As Boolean
016 
017 'x2. デバッグ・モード　★変更必須
018 '   True  : ログ出力有り
019 ' 　False : ログ出力無し
020 Const CON_DEBUG_MODE = True
021 'x3. 作業フォルダ　　　★変更必須
022 '   変更しないと動作しません
023 Const CON_WORK_FOLDER = "I:\Adobe PDF\Test_Excel_File\メタデータ\work"
024 
025 'x4. 作業用
026 Private msDuegLogFilePath       As String   'LOGファイルパス
027 Private mlDuegLogFileNo         As Long     'LOGファイルNO
028 Private msDuegLogCnt            As Long     'LOGの出力数
029 
030 Const CON_SELECT_NODES = "/x:xmpmeta/rdf:RDF/rdf:Description"
031 
032 
033 '**************************************************
034 '
035 ' Main (Test用)
036 '
037 '**************************************************
038 
039 Sub Test_Main()
040     
041     Dim sFilePath   As String   'PDFのフルパス
042     Dim sXml        As String   '抽出されたメタデータ(XML)
043     Dim lRet        As Long     '戻り値
044     Dim sMsg        As String   'メッセージ
045     
046     sFilePath = "I:\Adobe PDF\Test_Excel_File\メタデータ\work\AFormAut.pdf" 'Match OK
047     
048     '1. 前処理：メタデータの抽出
049     lRet = Get_XML_nnn2(sFilePath, sXml, sMsg)
050     
051     '2. メタデータから該当する要素名で値を抽出
052     If sXml <> "" Then
053         '1.タイトル(dc:title)
054         Debug.Print "タイトル(dc:title)=" & _
055             Get_XML_Node_nnn2(sXml, "dc:title")
056         '2.作成者(dc:creator)
057         Debug.Print "作成者(dc:creator)=" & _
058             Get_XML_Node_nnn2(sXml, "dc:creator")
059         '3.作成者の役職(photoshop:AuthorsPosition)
060         Debug.Print "作成者の役職(photoshop:AuthorsPosition)=" & _
061             Get_XML_Node_nnn2(sXml, "photoshop:AuthorsPosition")
062         '4.説明(dc:description)
063         Debug.Print "説明(dc:description)=" & _
064             Get_XML_Node_nnn2(sXml, "dc:description")
065         '5.説明記入者(photoshop:CaptionWriter)
066         Debug.Print "説明記入者(photoshop:CaptionWriter)=" & _
067             Get_XML_Node_nnn2(sXml, "photoshop:CaptionWriter")
068         '6.キーワード(pdf:Keywords)
069         Debug.Print "キーワード(pdf:Keywords)=" & _
070             Get_XML_Node_nnn2(sXml, "pdf:Keywords")
071         '7.著作権のステータス(xmpRights:Marked)
072             'False:著作権フリー
073             'True:著作権取得済み
074             '無い：不明
075         Debug.Print "著作権のステータス(xmpRights:Marked)=" & _
076             Get_XML_Node_nnn2(sXml, "xmpRights:Marked")
077         '8.著作権情報(dc:rights)
078         Debug.Print "著作権情報(dc:rights)=" & _
079             Get_XML_Node_nnn2(sXml, "dc:rights")
080         '9.著作権情報URL(xmpRights:WebStatement)
081         Debug.Print "著作権情報URL(xmpRights:WebStatement)=" & _
082             Get_XML_Node_nnn2(sXml, "xmpRights:WebStatement")
083         '(xmp:MetadataDate)
084         Debug.Print "xmp:MetadataDate=" & _
085             Get_XML_Node_nnn2(sXml, "xmp:MetadataDate")
086         
087         'フォーマット(dc:format)
088         Debug.Print "dc:format=" & Get_XML_Node_nnn2(sXml, "dc:format")
089         '(xmp:CreateDate)
090         Debug.Print "xmp:CreateDate=" & _
091             Get_XML_Node_nnn2(sXml, "xmp:CreateDate")
092         '(xmp:ModifyDate)
093         Debug.Print "xmp:ModifyDate=" & _
094             Get_XML_Node_nnn2(sXml, "xmp:ModifyDate")
095         '(xmp:CreatorTool)
096         Debug.Print "xmp:CreatorTool=" & _
097             Get_XML_Node_nnn2(sXml, "xmp:CreatorTool")
098         '(pdf:Producer)
099         Debug.Print "pdf:Producer=" & _
100             Get_XML_Node_nnn2(sXml, "pdf:Producer")
101         '(xmpMM:DocumentID)
102         Debug.Print "xmpMM:DocumentID=" & _
103             Get_XML_Node_nnn2(sXml, "xmpMM:DocumentID")
104         '(xmpMM:InstanceID)
105         Debug.Print "xmpMM:InstanceID=" & _
106             Get_XML_Node_nnn2(sXml, "xmpMM:InstanceID")
107         '？(dc:subject)
108         Debug.Print "dc:subject=" & Get_XML_Node_nnn2(sXml, "dc:subject")
109         
110     End If
111 
112     If lRet = 0 Then
113         MsgBox "正常終了", vbInformation
114     Else
115         MsgBox sMsg, vbCritical, "エラー発生"
116     End If
117     
118     'メモ帳を起動してログを表示
119     If CON_DEBUG_MODE Then
120         sMsg = "ログの画面を表示しますか？"
121         If msDuegLogCnt > 50 Then
122             sMsg = "ログ内容が沢山あります｡ " & vbCrLf & sMsg
123         End If
124         If MsgBox(sMsg, vbInformation + vbOKCancel, "確認") = vbCancel _
125             Then Exit Sub
126         Dim ReturnValue
127         ReturnValue = Shell("NOTEPAD.EXE " & msDuegLogFilePath, 1)
128         AppActivate ReturnValue
129     End If
130 
131 End Sub
132 
133 '**************************************************
134 '
135 ' Get XML Data for PDF file
136 '
137 '   PDFファイルにXML形式で入っているメタデータ(XMP)を
138 '   をテキストで抽出する｡
139 '
140 ' Create  : 2014/12/07
141 ' Update  : 2014/12/07
142 ' Vertion : 1.0.0
143 '
144 ' 引数1   : sFilePath As String (IN)
145 '           PDFファイルのフルパス
146 ' 引数2   : sGetXml 　As String (OUT)
147 '           取得したXML形式のメタデータ
148 ' 引数3   : sMsg    　As String (OUT)
149 '           エラー時の詳細なメッセージ
150 '
151 ' 戻り値  : 0 は正常終了
152 '           1 以上はエラー有り
153 '
154 ' 備考    : PDFファイルのメタデータがパスワードで
155 '           暗号化されている場合は取得できない。
156 '
157 ' URL     : https://pdf-file.nnn2.com/?p=791
158 '
159 ' その他  : 著作権等は主張しません。
160 '           上記URLにコメントを頂けると嬉しいです。
161 '
162 '**************************************************
163 
164 Private Function Get_XML_nnn2( _
165     ByVal sFilePath As String, _
166     ByRef sGetXml As String, _
167     ByRef sMsg As String) As Long
168     
169     Dim objStm          As New ADODB.Stream
170     Dim objXDoc         As New MSXML2.DOMDocument
171     Dim objXNode        As MSXML2.IXMLDOMNode
172     
173     Dim sDeugMsg        As String
174     Dim sOutPdfPath     As String
175     Dim lRet            As Long
176     Dim bRet            As Boolean
177     Dim i               As Long
178     Dim j               As Long
179     Dim k               As Long
180     
181     Dim sXml            As String
182     Dim lXMLcnt         As Long
183     Dim sInput          As String
184     Dim sXmlPath        As String
185     Dim iLineCnt        As Long
186     Dim lInStr_Cnt1     As Long
187     Dim lInStr_Cnt2     As Long
188     Dim lIndex_S        As Long
189     Dim lsInputLen      As Long
190     Dim sValue          As String
191     
192     '取得できたXMLの要素名と値
193     '   sXmlData(*, 0) : 要素名
194     '   sXmlData(*, 1) : 値
195     Dim sXmlData(999, 1)    As String
196     
197     Const CON_METADATA_START = "<x:xmpmeta "
198     Const CON_METADATA_END = "</x:xmpmeta>"
199     Const COM_XML_HEAD = _
200         "<?xml version=""1.0"" encoding=""Shift_JIS"" ?>" & vbCrLf
201     
202     '初期化
203     sMsg = ""
204     sGetXml = ""
205     Get_XML_nnn2 = 0
206     
207     '▼ログ・ファイルの前処理
208     If CON_DEBUG_MODE Then
209         msDuegLogCnt = 0
210         mlDuegLogFileNo = FreeFile
211         msDuegLogFilePath = CON_WORK_FOLDER & "\log-" & _
212             Format(Date, "yyyymmdd-") & Format(Time, " hhmmss") & ".txt"
213         sDeugMsg = "PDF-File : " & sFilePath
214         Call Put_Degug_log(sDeugMsg)
215     End If
216 
217     '▼事前チェック
218     '作業フォルダの存在チェック
219     If Dir(CON_WORK_FOLDER, vbDirectory) = "" Then
220         sMsg = CON_WORK_FOLDER & vbCrLf & _
221             "の作業フォルダが存在しない。" & vbCrLf & _
222             "処理は中断しました。"
223         Get_XML_nnn2 = 1
224         GoTo Get_XML_nnn2_End:
225     End If
226     'PDFファイルの存在チェック
227     If Dir(sFilePath) = "" Then
228         sMsg = sFilePath & vbCrLf & _
229             "PDFファイルが存在しない。" & vbCrLf & _
230             "処理は中断しました。"
231         Get_XML_nnn2 = 2
232         GoTo Get_XML_nnn2_End:
233     End If
234     
235     '▼OLEでPDF-Infoの取得
236     If AcroExch_PDDoc_GetInfo(sFilePath) = False Then
237         sMsg = "PDFファイルがOLEで読み込めなかった。" & vbCrLf & _
238                "処理は中断しました。"
239         Get_XML_nnn2 = 3
240         GoTo Get_XML_nnn2_End:
241     End If
242     
243     '▼PDFファイル内のMetaData(XML)を取得
244     sXml = ""
245     lXMLcnt = 0
246     iLineCnt = 0
247      
248     With objStm
249         .Type = adTypeText        '文字列型を指定
250         .Charset = "UTF-8"        '文字コード
251         .LineSeparator = adCRLF   '改行
252         .Open                     'Streamのオープン
253         .LoadFromFile (sFilePath) 'Streamへ読み込む
254     End With
255     
256     'EOSになるまでループ ※実際は１回のみ
257     Do While Not objStm.EOS
258     
259         sInput = objStm.ReadText(adReadAll) '一気にEOS(最後)まで読み込む
260         
261         iLineCnt = iLineCnt + 1
262         lsInputLen = Len(sInput)
263         lIndex_S = 1
264         
265         Do While lIndex_S < lsInputLen
266             
267             '開始要素と終了要素の位置を検索
268             lInStr_Cnt1 = InStr(lIndex_S, sInput, CON_METADATA_START)
269             If lInStr_Cnt1 = 0 Then Exit Do
270             lInStr_Cnt2 = InStr(lInStr_Cnt1, sInput, CON_METADATA_END)
271             If lInStr_Cnt2 = 0 Then Exit Do
272                 
273             '開始要素、終了要素が有る
274             k = lInStr_Cnt2 + Len(CON_METADATA_END) - lInStr_Cnt1
275             sXml = COM_XML_HEAD & Mid$(sInput, lInStr_Cnt1, k)
276             lXMLcnt = lXMLcnt + 1
277             
278             If CON_DEBUG_MODE Then
279                 Call Put_Degug_log("XML-NO:" & lXMLcnt & vbCrLf & sXml)
280             End If
281             
282             'XMLデータのチェック
283             If objXDoc.LoadXML(sXml) = False Then
284                 'エラー：読み込み失敗
285                 With objXDoc.parseError
286                     sMsg = "** XML 読み込み エラー ** " & lXMLcnt & vbCrLf & _
287                         .ErrorCode & " / " & Replace(.reason, vbCrLf, "") & vbCrLf & _
288                         "行 :" & .Line & " , カラム :" & .linepos & vbCrLf & _
289                         "内容 :" & .srcText & vbCrLf & _
290                         "データ先頭からの位置 :" & .filepos
291                 End With
292                 Get_XML_nnn2 = 10
293                 GoTo Get_XML_nnn2_End:
294             End If
295             
296             'ノードデータ格納の初期化
297             For i = LBound(sXmlData) To UBound(sXmlData)
298                 For j = LBound(sXmlData, 2) To UBound(sXmlData, 2)
299                     sXmlData(i, j) = ""
300                 Next j
301             Next i
302             
303             'ノードデータの抽出
304             i = 0
305             For Each objXNode In objXDoc.SelectNodes(CON_SELECT_NODES)
306                 For j = 0 To objXNode.ChildNodes.Length - 1
307                     If i > UBound(sXmlData) Then
308                         '※発生時はsXmlData配列を大きくする
309                         sMsg = "エラー発生：sXmlData配列のインデックス・オーバー"
310                         Get_XML_nnn2 = 11
311                         GoTo Get_XML_nnn2_End:
312                     End If
313                     sXmlData(i, 0) = objXNode.ChildNodes(j).nodeName
314                     sXmlData(i, 1) = objXNode.ChildNodes(j).nodeTypedValue
315                     i = i + 1
316                 Next j
317             Next
318             
319             'ノードデータ内で指定メタデータの存在チェック
320             If i = 0 Then
321                 If CON_DEBUG_MODE Then
322                     Call Put_Degug_log("XML-NO:" & lXMLcnt & _
323                         " にノードが存在しない。")
324                 End If
325             Else
326                 For i = LBound(sXmlData) To UBound(sXmlData)
327                     If sXmlData(i, 0) = "" Then Exit For
328                     If sXmlData(i, 0) = "xap:MetadataDate" Or _
329                        sXmlData(i, 0) = "xmp:MetadataDate" Then
330                         sValue = sXmlData(i, 1)
331                         If sValue <> "" Then
332                             sValue = Mid$(sValue, 1, 4) & _
333                                      Mid$(sValue, 6, 2) & _
334                                      Mid$(sValue, 9, 2) & _
335                                      Mid$(sValue, 12, 2) & _
336                                      Mid$(sValue, 15, 2) & _
337                                      Mid$(sValue, 18, 2)
338                             
339                             If sValue = Mid$(msGetInfo_ModDate, 3, 14) Then
340                                 '該当するXMLが見つかった
341                                 sGetXml = sXml
342                                 If CON_DEBUG_MODE Then _
343                                     Call Put_Degug_log("Match XML-No=" & lXMLcnt)
344                                 Exit Do
345                             End If
346                             '見つからなかったので、次のXMLを検索する
347                             Exit For
348                         End If
349                     End If
350                 Next i
351             End If
352             
353             Set objXDoc = Nothing
354             Set objXNode = Nothing
355 
356             '次のXMLを探す
357             lIndex_S = lInStr_Cnt1 + j
358         
359         Loop
360         
361         '該当するXMLが見つかったらLoopを抜ける
362         If sGetXml <> "" Then Exit Do
363     Loop
364         
365 '    Debug.Print "iLineCnt=" & iLineCnt
366     
367     '▼終了状態のチェック
368     If lXMLcnt = 0 Then
369         sMsg = "XMLデータがPDFに存在しない。" & vbCrLf & _
370             "PDFのパスワード設定により" & vbCrLf & _
371             "メタデータ(XMLデータ)が暗号化されている可能性が有ります。"
372         Get_XML_nnn2 = 21
373     ElseIf sGetXml = "" Then
374         sMsg = "該当するXMLデータが検索できなかった。" & vbCrLf & _
375             "上記エラー番号から関数プログラムをチェックして下さい。"
376         Get_XML_nnn2 = 22
377     Else
378         sMsg = "正常終了：XMLデータが取得できた。"
379         Get_XML_nnn2 = 0
380     End If
381     
382 Get_XML_nnn2_End:
383     
384     'PDFファイルを閉じる(Streamのクローズ)
385     objStm.Close
386     Set objStm = Nothing
387     Set objXDoc = Nothing
388         
389     If CON_DEBUG_MODE Then Call Put_Degug_log(sMsg)
390 
391 End Function
392 
393 
394 '**************************************************
395 '
396 ' Get XML Node Data for Text String
397 '
398 '   テキストのXML形式で入っているメタデータから
399 '   該当する要素に対するノードデータを抽出する｡
400 '
401 ' Create  : 2014/12/07
402 ' Update  : 2014/12/07
403 ' Vertion : 1.0.0
404 '
405 ' 引数1   : sXml As String (IN)
406 '           XML形式のメタデータ
407 ' 引数2   : sNodeName As String (IN)
408 '           検索する要素名
409 '
410 ' 戻り値  : 要素名と一致したテキストのノードデータ。
411 '           抽出できなかった時は""を返す。
412 '
413 ' 備考    : 特に無し
414 '
415 ' URL     : https://pdf-file.nnn2.com/?p=791
416 '
417 ' その他  : 著作権等は主張しません。
418 '           上記URLにコメントを頂けると嬉しいです。
419 '
420 '**************************************************
421 
422 Private Function Get_XML_Node_nnn2( _
423     ByVal sXml As String, _
424     ByVal sNodeName As String) As String
425 
426     Dim objXDoc    As New MSXML2.DOMDocument
427     Dim objXNode   As MSXML2.IXMLDOMNode
428     
429     Get_XML_Node_nnn2 = ""
430     
431     If objXDoc.LoadXML(sXml) = False Then
432         ' 読み込み失敗時
433 '        Debug.Print "読み込み失敗時:Get_XML_Node_nnn2"
434         Exit Function
435     End If
436     
437     'ノードデータの抽出
438     For Each objXNode In objXDoc.SelectNodes( _
439             CON_SELECT_NODES & "/" & sNodeName)
440         Get_XML_Node_nnn2 = objXNode.Text
441         Exit Function
442     Next
443     
444     Set objXDoc = Nothing
445     Set objXNode = Nothing
446     
447 End Function
448 
449 
450 '**************************************************
451 '
452 ' PDFファイルの情報をOLE(IAC)のみで取得する
453 '
454 ' 備考
455 '     msGetInfo_ModDate = objAcrobatPDDoc.GetInfo("ModDate")
456 '     のみ実行できればOK｡
457 '
458 '**************************************************
459 
460 Private Function AcroExch_PDDoc_GetInfo( _
461     ByVal sFilePaht As String) As Boolean
462 
463     Dim objAcrobatPDDoc As New Acrobat.AcroPDDoc
464     Dim lRet            As Long
465     Dim sDeug           As String
466 
467     'PDFオブジェクトをオープンする。
468     '注意）Acrobatは画面に表示されない。
469     lRet = objAcrobatPDDoc.Open(sFilePaht)
470     If lRet = 0 Then
471         If CON_DEBUG_MODE Then _
472             Call Put_Degug_log("ERROR: PDFをOPEN出来なかった")
473         AcroExch_PDDoc_GetInfo = False
474         Exit Function
475     End If
476     
477     '文書プロパティの更新日
478     msGetInfo_ModDate = objAcrobatPDDoc.GetInfo("ModDate")
479     
480     If CON_DEBUG_MODE Then
481         '文書プロパティのタイトル
482         msGetInfo_Title = objAcrobatPDDoc.GetInfo("Title")
483         '文書プロパティの作成者
484         msGetInfo_Author = objAcrobatPDDoc.GetInfo("Author")
485         '文書プロパティのサブタイトル
486         msGetInfo_Subject = objAcrobatPDDoc.GetInfo("Subject")
487         '文書プロパティのキーワード
488         msGetInfo_Keywords = objAcrobatPDDoc.GetInfo("Keywords")
489         '文書プロパティのアプリケーション
490         msGetInfo_Creator = objAcrobatPDDoc.GetInfo("Creator")
491         '文書プロパティのPDF変換
492         msGetInfo_Producer = objAcrobatPDDoc.GetInfo("Producer")
493         '文書プロパティの作成日
494         msGetInfo_CreationDate = objAcrobatPDDoc.GetInfo("CreationDate")
495         '文書プロパティの
496         msGetInfo_Trapped = objAcrobatPDDoc.GetInfo("Trapped")
497         'PermanentID
498         msGet_GetPermanentID = objAcrobatPDDoc.GetPermanentID
499         'ファイル名
500         msGet_FileName = objAcrobatPDDoc.GetFileName
501         '変更可能かチェック:先頭ページの削除を試みる
502         mbGet_DeletPage = objAcrobatPDDoc.DeletePages(0, 0)
503     
504         sDeug = _
505         "GetInfo(""Title"")=(" & msGetInfo_Title & ")" & vbCrLf & _
506         "GetInfo(""Author"")=(" & msGetInfo_Author & ")" & vbCrLf & _
507         "GetInfo(""Subject"")=(" & msGetInfo_Subject & ")" & vbCrLf & _
508         "GetInfo(""Keywords"")=(" & msGetInfo_Keywords & ")" & vbCrLf & _
509         "GetInfo(""Creator"")=(" & msGetInfo_Creator & ")" & vbCrLf & _
510         "GetInfo(""Producer"")=(" & msGetInfo_Producer & ")" & vbCrLf & _
511         "GetInfo(""CreationDate"")=(" & msGetInfo_CreationDate & ")" & vbCrLf & _
512         "GetInfo(""ModDate"")=(" & msGetInfo_ModDate & vbCrLf & _
513         "GetInfo(""Trapped"")=(" & msGetInfo_Trapped & ")" & vbCrLf & _
514         "GetPermanentID=(" & msGet_GetPermanentID & ")" & vbCrLf & _
515         "GetFileName=(" & msGet_FileName & ")" & vbCrLf & _
516         "DeletPage=(" & mbGet_DeletPage & ")" & _
517         IIf(mbGet_DeletPage = False, "PDFがパスワード設定で保護されています", "")
518         Call Put_Degug_log(sDeug)
519     End If
520     
521     'PDFオブジェクトを解放する。
522     objAcrobatPDDoc.Close   '※変更は反映されない
523     Set objAcrobatPDDoc = Nothing
524     
525     AcroExch_PDDoc_GetInfo = True
526 End Function
527 
528 
529 '**************************************************
530 '
531 ' LOG の出力 : デバッグ＆確認用
532 '
533 ' 備考
534 '    不要時は削除してください。
535 '
536 '**************************************************
537 
538 Private Sub Put_Degug_log(ByVal sDeug As String)
539 
540     Open msDuegLogFilePath For Append As #mlDuegLogFileNo
541     Print #mlDuegLogFileNo, _
542             Format(Date, "yyyy/mm/dd") & _
543             Format(Time, " hh:mm:ss") & _
544             vbCrLf & sDeug & vbCrLf
545     Close #mlDuegLogFileNo
546         
547     msDuegLogCnt = msDuegLogCnt + 1
548 End Sub
549

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

実行結果のサンプル

タイトル等をセットする。

ドキュメントタイトル、作成者等をセットする。

それがXMPに反映された結果が以下の画面。

以下はサンプルの実行結果です。

Source file

タイトル(dc:title) = ①AFormAut : Fields.Add メソッド 
作成者(dc:creator) = ②nori 
作成者の役職(photoshop:AuthorsPosition) = ③hira 
説明(dc:description) = ④OLEでAcrobat を操作する 
説明記入者(photoshop:CaptionWriter) = ⑤nori-san 
キーワード(pdf:Keywords) = ⑥Acrobat; OLE; IAC; VBA 
著作権のステータス(xmpRights:Marked) = False 
著作権情報(dc:rights) = ⑧著作権の情報 
著作権情報URL(xmpRights:WebStatement) = ⑨ pdf-file.nnn2.com 
xmp:MetadataDate = 2014-12-07T17:43:13+09:00 
dc:format = application/pdf 
xmp:CreateDate = 2014-02-19T09:50:18+09:00 
xmp:ModifyDate = 2014-12-07T17:43:13+09:00 
xmp:CreatorTool = MicrosoftR Office Word 2007 
pdf:Producer = MicrosoftR Office Word 2007 
xmpMM:DocumentID = uuid:****6734-****-43cb-***-f73a331d**** 
xmpMM:InstanceID = uuid:****f7c1-****-4f62-****-5d1175d3**** 
dc:subject = ⑥Acrobat OLE IAC VBA

※上記結果の****部分は一部をマスクしました。

備考

PDDoc：GetInfo メソッドでは取得できない情報が取れます。
今後、メンテナンスや再調査等が発生する感じがするので、デバッグルーチンは残して置きます。
不要ならば削除して流用ください。
メタデータが抽出できないPDFでも、PDDoc：GetInfo メソッドでいくつかのプロパティは取得できます。
Adobe XMP の SDK（英語）が公開されていますが、時間の関係上で参考にはしていません。

参考にしたサイト

メタデータ

PDF - メタデータ (Metadata)
メタデータの基本情報

XML , XMP

仕切り屋本舗, VBA
XMLの基本的な処理方法の説明
XMP PDF埋め込みメタデータコラム1
メタデータのXMP(XML)の基本内容
Adobe XMP 仕様書 (2004年1月日本語版) PDF:92頁
Wikipedia XMP
XMP Librarian Gateway Nature Publishing Group
Adobe XMP Developer Center
Extensible Metadata Platform (XMP)

ADODB.Stream

メタデータとは

文書の特性やプロパティを明記したデータです。

文書の本文やファイルが持つコンテンツと異なる情報です。

例えばPDF文書の場合、各ページに見える文書はコンテンツでメタデータでは無いです。

PDF文書が持つ、タイトル、作成者、作成日、変更日時、等のプロパティがメタデータになります。

XMPとは

Adobe 社が制定したメタデータの標準フォーマットです。

さまざまなアプリケーションでメタデータを作成、処理および交換する為の基準となります。

XMP（Extensible Metadata Platform）の略称。

参考： Adove XMP 仕様書 (2004年1月日本語版)

動作確認環境

Windows 7 64bit Professional (SP1 + MicrosoftUpdate) + Excel 2007 (SP3)

< サンプル一覧 >

サイト管理人のメモ

これ以下はサイト管理人のメモです。

見なくて結構です。

sInput = objStm.ReadText ( adReadAll )

ReadText の第一引数

adReadAll (-1) :
既定値です。
現在の位置から EOS マーカー方向に、すべてのバイトをストリームから読み取ります。
これは、バイナリストリームに唯一有効な StreamReadEnum 値です (Type は adTypeBinary)。
adReadLine(-2) :
ストリームから次の行を読み取ります (LineSeparator プロパティで指定)。

どちらの引数を指定しても結果は同じみたい。

xmp:MetadataDate

メタデータの要素「MetadataDate」は以下の２種類で検索してる。

xap:MetadataDate
xmp:MetadataDate

Adobe XMP 仕様書 (2004年1月日本語版) を見ると下の「xmp:MetadataDate」の解説が有る。

しかし、PDFファイルをGREP検索すると上の「xap:MetadataDate」だけしか存在しないPDFファイルも有る。

xmp:MetadataDate の説明 Adobe XMP 仕様書 (2004年1月日本語版) 36頁より
このリソースのメタデータが最後に変更された日時。
このプロパティには xmp:ModifyDate と同じか、より最近の値が設定されている必要があります。

Do While Not objStm.EOS

ReadText ( adReadAll ) で一気にEOSまで、つまりファイルの最後まで読み込むので、

Do でループさせる必要も無いが、Stream オブジェクト自体の操作は今回が初めてなので安全策をコードに持たせる。

If lInStr_Cnt2 = 0 Then Exit Do

上記の条件が成り立って、Exit Do される事はありえない。

仮になっても「XMLデータが無い」等のエラーになる可能性が有るので、この時点でのエラーログ・メッセージは出さない。

If sValue = Mid$(mstrGetInfo_ModDate, 3, 14) Then

ModDate と同じ更新日時の XMPデータ(メタデータ)は１つしか存在しないという前提で処理を行う。

よって条件が一致したら、残りのXMPデータの抽出＆検索は行わない。