VBAコードのアレンジについて

投稿者 : たか     投稿日時 : 2022/06/23(Thu) 09:22:59     OS : Windows 10     EXCEL : 未指定

---

VBAはほぼ素人ですのでお手柔らかにお願い致します。

Sub Word()
Dim wdDoc
Dim i As Long
Dim wdApp As Word.Application
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open("C:\Users\Desktop\個人フォルダ\PDF抽出\20220228132332.pdf")
For i = 1 To wdDoc.Paragraphs.Count
With ActiveSheet
.Cells(5, 4).Value = wdDoc.Range.Paragraphs(22).Range.Text
.Cells(5, 5).Value = wdDoc.Range.Paragraphs(10).Range.Text
End With
Next

上記コードが多くありますが動きはします。やりたい事は2つあります。
①上記のPDFは全て1つ1つ指定していますが頃をフォルダにあるPDFすべてを対象にしたい
②セルの場所を1つ指定したらそこからはその行からしたに繰り返しが出来る様にしたい。

言いたい事が分からないかもしれませんが宜しくお願い致します。

投稿者 : さんこう     投稿日時 : 2022/06/23(Thu) 09:30:24

---

参考になれば。

https://www.google.com/search?q=vba+%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E5%86%85%E3%81%AE%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%82%92%E9%A0%86%E7%95%AA%E3%81%AB%E5%87%A6%E7%90%86+Dir

投稿者 : たか     投稿日時 : 2022/06/23(Thu) 09:46:55

---

参考にさせて頂きます。

始めに記載したコードに足していってみます。

投稿者 : てらてら     投稿日時 : 2022/06/23(Thu) 19:27:21

---

こんにちは。

真ん中のFor文が意味が無いように思います。
Paragraphs(22)(10)のように順不同ならFor文は役に立たないかもしれませんね。

＞①上記のPDFは全て1つ1つ指定していますが頃をフォルダにあるPDFすべてを対象にしたい
これは、定番のやり方なので初心者なら覚えておいて損はないと思います。

＞②セルの場所を1つ指定したらそこからはその行からしたに繰り返しが出来る様にしたい。
これはcnt変数の使い方に注目してください。繰り返しだからと言ってFor文一辺倒では手詰まりです。

参考にしてください。

Sub Sample1()
    Dim i As Long, cnt As Log
    Dim filepath As String, cnt As Long '変数の宣言
    Const folderpath  As String = "C:\Users\Desktop\個人フォルダ\" '定数の宣言
    filepath = Dir(folderpath & "*.pdf") 'dir関数でフォルダの中のファイル名を返します(今回はPDF)
    
    cnt = 5 'Excelシートの行数
    Do While filepath <> "" '変数に空白が入るまで処理を繰り返す
        
        'Workbooks.Open (folderpath & filepath) 'ワークブックを開いていく
        '//今回はワードなので、、、
        Dim wdDoc
        Dim wdApp As Word.Application
        Set wdApp = CreateObject("Word.Application")
        Set wdDoc = wdApp.Documents.Open(filepath)
        
        'For i = 1 To wdDoc.Paragraphs.Count  '全てのParagraphsをループする？
            With ActiveSheet
            
            '/// Paragraphs(22)(10)のみコピーするならFor分は不要
            .Cells(cnt, 4).Value = wdDoc.Range.Paragraphs(22).Range.Text
            .Cells(cnt, 5).Value = wdDoc.Range.Paragraphs(10).Range.Text
            cnt = cnt + 1
            End With
        'Next
        
        Workbooks(filepath).Close SaveChanges:=True
        '変数にまだ入力されていないファイル名を格納する
        filepath = Dir()
    Loop 'Do While に戻る
    
End Sub