実現したいこと
- フォルダに入っている複数のpdfを開き、Excelシートに値の貼付けをしたいです。
--フォルダに保管されているpdfが20件あります。
--このpdfを1つ開き、値のコピーをします。
--Excelの"データシート"のA1行目に値を貼り付けします。
--次のpdfを開き、値のコピーをし、B1行目に値の貼付けをします。
--この一連の作業を自動で繰り返し、フォルダ内のpdfをすべて開いたら
コピー作業は終了します。
--PDFは手動で閉じます。
前提
EXCELVBA
1Sub CopyPDFContentsToExcel() 2 3 Dim folderPath As String 4 Dim fileName As String 5 Dim shellApp As Object 6 Dim pdfText As String 7 Dim excelSheet As Worksheet 8 Dim currentColumn As Long 9 Dim i As Long 10 11 ' フォルダのパスを取得 12 With Application.FileDialog(msoFileDialogFolderPicker) 13 .Title = "PDFファイルが入ったフォルダを選択してください" 14 If .Show = -1 Then 15 folderPath = .SelectedItems(1) 16 Else 17 Exit Sub ' フォルダを選択せずにキャンセルした場合、処理を終了 18 End If 19 End With 20 21 ' Excelのシートを準備 22 Set excelSheet = ThisWorkbook.Sheets("データシート") 23 currentColumn = 1 ' 最初はA列からスタート 24 25 ' フォルダ内のPDFファイルを一つずつ処理 26 For i = 1 To 10 27 fileName = Dir(folderPath & "\*.pdf") 28 If fileName = "" Then 29 Exit For ' ファイルがない場合は処理を終了 30 End If 31 32 ' PDFファイルを開く 33 Set shellApp = CreateObject("Shell.Application") 34 shellApp.Open (folderPath & "\" & fileName) 35 36 ' 少し待つ(必要に応じて調整してください) 37 Application.Wait Now + TimeValue("00:00:02") 38 39 ' PDFファイルの内容をクリップボードにコピー 40 Application.SendKeys "^a", True 41 Application.SendKeys "^c", True 42 43 ' クリップボードの内容を取得 44 'pdfText = GetClipboardText 45 46 ' Excelシートに貼り付け 47 ActiveSheet.PasteSpecial Format:="Unicode テキスト", Link:=False, _ 48 DisplayAsIcon:=False, NoHTMLFormatting:=True 49 50 ' PDFファイルを閉じる 51 'On Error Resume Next ' エラーを無視して閉じる 52 'shellApp.Windows.Find("Adobe Acrobat Reader").Close 53 'On Error GoTo 0 ' エラー処理を元に戻す 54 55 ' 次のファイルを処理 56 currentColumn = currentColumn + 1 57 Next i 58 59End Sub 60 61
発生している問題・エラーメッセージ
エラーメッセージは表示されません。 1枚目のpdfが開き、コピー後、データシートA1への値の貼付けはします。 2枚目以降pdfが開かず、作業も中断されません。
試したこと
' PDFファイルを閉じる
の部分がうまく動かないのでコメントとして残してあります。
補足情報(FW/ツールのバージョンなど)
EXCELは2019です。
自力での解決が難しく、ご教授お願い致します。
どうぞよろしくお願いします。

回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2023/08/29 00:56
2023/08/30 12:56