トップ > 汎用コード > PDFデータのExcel一括取り込み(指定フォルダの全PDF対象)

PDFデータのExcel一括取り込み(指定フォルダの全PDF対象)

指定したフォルダ内の全PDFのデータを、まとめてExcelに取り込むマクロです。
現時点(2021/4/15)で、PDFファイルをExcelへ直接取り込むことは、Microsoft365では可能ですが、他のバージョンでは無理なようです。他のバージョンのExcelでもPDFのデータ取得するために、Wordを利用して取り込みます。

VBAでPDFデータをExcelに取り込む場合、AdobeのAcrobat Proを使用した方法が有名なようですが、Acrobatを購入する程の使用頻度でもない場合は、Wordを利用して取り込むのが良いでしょう。
ここではWordを経由してExcelにPDFデータを取り込むマクロを紹介します。マクロはフォルダ内のPDFデータを一括で取り込む形になっています。

今回は、WordでPDFファイルを開く関係で、対応可能なバージョンが限られており、また事前に少し設定が必要になります。

対応Officeバージョン:Office2013/2016/2019
※Microsoft365での動作は未確認です

事前準備WordでPDFを開く

Wordで何かしらのPDFファイルを一度開いてください。
WordからPDFファイルを開くと、初回に確認のメッセージが表示されます。
そのメッセージ内のチェックボックスにチェックを付けて「OK」を押し、次から同じメッセージが表示されないよう設定します。※



※次のサイトに、VBA操作で確認メッセージを表示しない方法が紹介されています
【VBA】PDF を WORD に変換してテキストを取得する(確認メッセージを表示しない)


サンプルコード

コードの貼り付け場所

'+++ 宣言セクション +++ 対応:Microsoft Office2013/2016/2019
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

'///一般的なマクロより多くの時間を要します Sub Get_Pdf_Data() '実行用マクロ フォルダ内全てのPDFのテキストデータを取得 Dim strDirPath As String 'フォルダの選択 With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then strDirPath = .SelectedItems(1) End With If Len(strDirPath) = 0 Then Exit Sub 'フォルダの存在確認 If Dir(strDirPath, vbDirectory) = "" Then Exit Sub 'フォルダ内PDF検索 Call Search_PdfFiles(strDirPath) End Sub
Private Sub Search_PdfFiles(ByVal strPath As String) 'フォルダ内PDF検索 Dim strTarget As String Dim strDirPath As String With Application strPath = strPath & .PathSeparator 'フォルダパスにフォルダ区切り文字追加 strTarget = Dir(strPath & "*.pdf") 'フォルダ内のPDFを検索 If strTarget = "" Then Exit Sub 'PDFがなければ終了 Do Call Get_Data_Main(strPath, strTarget) 'テキスト取得メインルーチン strTarget = Dir() '次のExcelブックを検索 Loop Until strTarget = "" 'ブックがなければループから抜ける End With strTarget = Dir("") End Sub
Private Sub Get_Data_Main(ByVal DirPath As String, ByVal FileName As String) 'データ取得メイン Dim objWord As Object Dim objDocs As Object Dim objTask As Object Set objWord = CreateObject("Word.Application") 'Wordインスタンス作成 objWord.DisplayAlerts = False objWord.Visible = True 'Wordを非表示する場合はこの行をコメントにする Set objDocs = objWord.Documents.Open(DirPath & FileName) '開いたドキュメントの参照をオブジェクト型変数に格納 FileName = Replace$(FileName, ".pdf", "", , , vbTextCompare) Do Call Sleep(50) For Each objTask In objWord.Tasks If 0 < InStr(1, objTask.Name, FileName, vbTextCompare) Then Exit Do 'Wordドキュメントが開いたら先に進む Next Loop objDocs.Content.Copy 'ドキュメントコピー With ThisWorkbook .Sheets.Add After:=ActiveSheet .ActiveSheet.Paste '「値のみ貼りつけ」は、この行をコメントにし、下の行のコメント外す '.ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True .ActiveSheet.Range("A1").Copy Excel.Application.CutCopyMode = False End With objDocs.Close 'ドキュメントを閉じる objWord.DisplayAlerts = True objWord.Quit 'Wordアプリケーションを終了する Set objTask = Nothing 'オブジェクト変数破棄 Set objDocs = Nothing ' Set objWord = Nothing ' End Sub

マクロを実行すると、フォルダの参照ダイアログが表示されます。
フォルダを選択すると処理が始まります。
【処理の流れ】
 1.フォルダ内のpdfファイルを探す(見つからない場合は終了)
 2.Wordを作成しWordでPDFファイルを開く
 3.開いたPDFファイルのデータをコピーする
 4.Excelに新しいシートを追加し、そのシートにデータを貼り付ける
 5.Wordを閉じて、次のPDFファイルを探す


サンプルファイル

今回のコードを載せたファイルを準備しました。よければご使用ください。
●サンプルファイル ダウンロード




ページトップへ戻る

Excel 汎用コード



Word 汎用コード

Copyright(C) 2009- 坂江 保 All Rights Reserved.