自分用メモ3

Sub ImportPDFandRemoveQuery()
   Dim wb As Workbook
   Dim ws As Worksheet
   Dim queryName As String
   Dim pdfPath As String
   Dim mCode As String
   Dim fd As FileDialog

   Set wb = ThisWorkbook
   Set ws = wb.Sheets("Sheet1") ' 必要に応じてシート名を変更してください
   queryName = "PDFQuery" ' クエリ名を適宜変更してください

   ' ファイルダイアログを表示してPDFファイルを選択
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   With fd
       .Title = "Select PDF File"
       .Filters.Add "PDF Files", "*.pdf", 1
       .AllowMultiSelect = False
       If .Show = -1 Then
           pdfPath = .SelectedItems(1)
       Else
           MsgBox "No file selected. Exiting macro."
           Exit Sub
       End If
   End With

   ' Power QueryのMコードを生成
   mCode = _
       "let" & vbCrLf & _
       "    Source = Pdf.Tables(File.Contents(""" & pdfPath & """), [Implementation=""1.3""])," & vbCrLf & _
       "    AllTables = Table.Combine(Table.TransformColumns(Source, {""Tables"", each Table.ExpandTableColumn(_, ""Table"") }))" & vbCrLf & _
       "in" & vbCrLf & _
       "    AllTables"

   ' クエリを追加
   On Error Resume Next
   wb.Queries(queryName).Delete
   On Error GoTo 0
   wb.Queries.Add Name:=queryName, Formula:=mCode

   ' クエリをシートに読み込み
   With ws.ListObjects.Add(SourceType:=0, Source:= _
       "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryName & ";Extended Properties=""""" _
       , Destination:=ws.Range("A1")).QueryTable
       .CommandType = xlCmdSql
       .CommandText = Array("SELECT * FROM [" & queryName & "]")
       .BackgroundQuery = True
       .Refresh BackgroundQuery:=False
   End With

   ' テーブルを値としてコピー
   ws.ListObjects(1).Range.Copy
   ws.Cells(1, 1).PasteSpecial Paste:=xlPasteValues

   ' クエリを削除
   On Error Resume Next
   With wb.Queries(queryName)
       .Delete
   End With
   On Error GoTo 0

   ' クエリ接続を削除
   On Error Resume Next
   wb.Connections(queryName).Delete
   On Error GoTo 0

   MsgBox "PDFからのテーブルのインポートが完了し、クエリが削除されました。"
End Sub