PDFファイルからエクセルファイル変換�@

Sub Get_Pdf_Data1() '実行用マクロ　フォルダ内全ての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インスタンス作成

Application.DisplayAlerts = False
'MLEvalString ("myLongOperation")

objWord.DisplayAlerts = False
objWord.Visible = True 'Wordを非表示する場合はこの行をコメントにする
Set objDocs = objWord.Documents.Open(DirPath & FileName) '開いたドキュメントの参照をオブジェクト型変数に格納
FileName = Replace$(FileName, ".pdf", "", , , vbTextCompare)
Do
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 '
Application.DisplayAlerts = True

End Sub