質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.30%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

538閲覧

【EXCEL VBA】フォルダに入っている複数のpdfを開き、Excelシートに値の貼付けをしたい。

mari_0418

総合スコア2

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

1クリップ

投稿2023/08/26 02:49

編集2023/08/26 02:52

実現したいこと

  • フォルダに入っている複数の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です。
自力での解決が難しく、ご教授お願い致します。
どうぞよろしくお願いします。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

取り急ぎ、絶妙に説明が難しいので、修正したソースを貼り付けます。

Excel

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 '★ 少し待つ(必要に応じて調整してください) 22 Application.Wait Now + TimeValue("00:00:02") 23 24 '★1 Shellインスタンス化 25 Set shellApp = CreateObject("Shell.Application") 26 27 ' Excelのシートを準備 28 Set excelSheet = ThisWorkbook.Sheets("データシート") 29 currentColumn = 1 ' 最初はA列からスタート 30 31 '★2 最初のPDFを取得 32 fileName = Dir(folderPath & "\*.pdf") 33 34 ' フォルダ内のPDFファイルを一つずつ処理 35' For i = 1 To 10 36 Do While fileName <> "" '★3 37 38' fileName = Dir(folderPath & "\*.pdf") ★2 39' If fileName = "" Then 40' Exit For ' ファイルがない場合は処理を終了 ★3 41' End If 42 43 ' PDFファイルを開く 44' Set shellApp = CreateObject("Shell.Application") '★1 45' shellApp.Open (folderPath & "\" & fileName) '★4 46 shellApp.ShellExecute folderPath & "\" & fileName, 1 '★4 47 48 ' 少し待つ(必要に応じて調整してください) 49 Application.Wait Now + TimeValue("00:00:02") 50 51 ' PDFファイルの内容をクリップボードにコピー 52 Application.SendKeys "^a", True 53 Application.SendKeys "^c", True 54 55 ' クリップボードの内容を取得 56 'pdfText = GetClipboardText 57 58 '★4 PDFを閉じる 59 Application.SendKeys "%{F4}", True 60 61 '★ 少し待つ(必要に応じて調整してください) 62 Application.Wait Now + TimeValue("00:00:02") 63 64' ' Excelシートに貼り付け ★5 65' ActiveSheet.PasteSpecial Format:="Unicode テキスト", Link:=False, _ 66' DisplayAsIcon:=False, NoHTMLFormatting:=True 67 68 '★5 Excelシートに貼り付け 69 excelSheet.Cells(1, currentColumn).Select 70 excelSheet.PasteSpecial Format:="Unicode テキスト", Link:=False, _ 71 DisplayAsIcon:=False, NoHTMLFormatting:=True 72 73 74 ' PDFファイルを閉じる ★4 75 'On Error Resume Next ' エラーを無視して閉じる 76 'shellApp.Windows.Find("Adobe Acrobat Reader").Close 77 'On Error GoTo 0 ' エラー処理を元に戻す 78 79 '★2 次のファイルを取得 80 fileName = Dir() 81 82 ' 次のファイルを処理 83 currentColumn = currentColumn + 1 84 85' Next i 86 Loop 87 88 '★1 解放 89 Set shellApp = Nothing 90 91End Sub

指定のフォルダ内のファイルは存在する数だけループできるようにしています(★2、★3)
Dir関数は、最初に開くフォルダとファイル指定をした後、Dir()で次のファイルになるため、Dir(folderPath & "*.pdf")を呼ぶと1つ目のファイルが常に取得されます。

PDFの部分はファイルによるので、待ち時間などは調整してください。
shellApp.ShellExecuteでPDFをアクティブにして、Alt+F4で閉じる手抜き処理していますので、他の操作をするとその操作しているアプリが閉じられたりします。

ざっくりですが、参考になれば幸いです。

投稿2023/08/26 17:50

crowmt

総合スコア402

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

mari_0418

2023/08/29 00:56

実現したいこと、の通り動作しました。[Alt+F4]の処理についてのご説明もありがとうございます。いただいたコメントと、プログラムをよくみて問題点が解決できるように勉強したいと思います。ありがとうございました。
crowmt

2023/08/30 12:56

無事に解決したようで何よりです。 色々調べて試されていることはソースで分かります。 おしい、あと少しという部分が散見されますので、後は理屈が整えば、ふとわかる瞬間が来ると思います。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.30%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問