フォルダにあるPDF情報の抽出(VBA)

フォルダにあるPDF情報の抽出
フォルダを入力したら、その中にあるPDFの情報をエクセルに抽出するなマクロを作成したいです。

～流れ～
エクセルを立ち上げたらAUTO OPENでアドレスを入力できるようにし、PDFが入っているアドレスを入力。
↓
SHEET1のA列にPDF名称。B列にPDF作成者。C列にPDF出力日
が出てくるようにしたいです。
各1行目は"PDF名称""PDF作成者"PDF出力日"がTITLEとして表示されているので、2行目から抽出します。

以上、よろしくお願いします。

No.2 ベストアンサー 回答者： x-1919 回答日時： 2018/01/22 13:08

私の環境では Acrobat DC がインストールされていますが、バージョンによって書き方が違う可能性もあります。

また、Reader しか持っていない環境でどうなるかは試していません。

参照設定で 「Acrobat」 にチェックを入れておきます。

Dim acrPdDoc As Acrobat.AcroPDDoc

Set acrPdDoc = New Acrobat.AcroPDDoc
acrPdDoc.Open ("E:\hoge\test.pdf")

MsgBox acrPdDoc.GetFileName ' ファイル名
MsgBox acrPdDoc.GetInfo("Title") ' 文書タイトル
MsgBox acrPdDoc.GetInfo("Author") ' 作成者
MsgBox acrPdDoc.GetInfo("CreationDate") ' 作成日
MsgBox acrPdDoc.GetInfo("ModDate") ' 更新日

acrPdDoc.Close
Set acrPdDoc = Nothing

この回答へのお礼

ありがとうございます、明日試してみます！

お礼日時：2018/01/25 21:18

No.1 回答者： fujillin 回答日時： 2018/01/19 13:16

こんにちは

ファイルを検索するのはそれほど難しくはないと思いますが、
＞A列にPDF名称。B列にPDF作成者。C列にPDF出力日
作者名や出力日の情報のありかを私は知りません。
作者名はPDF独自情報として存在するのは存じていますが、出力日は見たことがないですね。

いずれにしろ、PDF独自のプロパティなので、一旦、PDFを開いてドキュメント情報から取得することになるのかと思いますが、一覧を作成するために全部のファイルを開くのでは時間ばかりかかることになりそうな気がします。
M$Office系のファイルにも同様の独自情報がありますが、M$から「Developer Support OLE File Property Reader」なるものがdllとして公開されているので、これを利用することで、ファイルを開くことなく情報を取得できるようです。
https://www.microsoft.com/en-us/download/details …
もし、PDF(Adobe社）でも同様のものを出してくれていれば、比較的簡単に取得できるかも知れません。（作成されているのかどうかは知りません）

・・・というわけで、以下はPDFファイルを検索し、通常の範囲で取得可能な「ファイル名」、「作成日」、「最終更新日」をご質問の要領で表示する参考例です。
骨格としては利用できるのではないかと思いますが、「作者名」、「出力日」の抽出に関しては、質問者様の方でお調べ願います。

Sub Sample()
　Dim Fso As Object, Dgl As Object, file
　Dim fPath As String, r As Range

　Set Fso = CreateObject("Scripting.FileSystemObject")
　Set Dgl = Application.FileDialog(msoFileDialogFolderPicker)
　fPath = ""
　Set r = Worksheets("Sheet1").Cells(2, 1)
　r.Worksheet.UsedRange.Offset(1).ClearContents

　If Dgl.Show = False Then Exit Sub
　fPath = Dgl.SelectedItems(1) & "\"

　For Each file In Fso.getfolder(fPath).Files
　　If LCase(Fso.getextensionname(file.Name)) = "pdf" Then
　　　r.Value = file.Name
　　　r.Offset(0, 1).Value = file.DateCreated
　　　r.Offset(0, 2).Value = file.DateLastModified
　　　Set r = r.Offset(1, 0)
　　End If
　Next file
　If r.Row = 2 Then r.Value = "該当ファイルなし"
End Sub

この回答へのお礼

ありがとうございました。もう少し自分でも調べてみますm(_ _)m

お礼日時：2018/01/25 21:19