指定した文字列を各フォルダーで検索、見つかったファイルのパスをコピー、検索した文字列と同じ行にあるC列のセルに貼り付けます。

投稿者 : Nabejiro     投稿日時 : 2024/06/15(Sat) 13:57:15     OS : Windows 10     EXCEL : Office 365

---

下記の操作を実行するVBAコードをご教示いただけないでしょうか。
皆様のお力添えを賜りたく、お願い申し上げます。

【操作内容の概略】
指定した文字列を各フォルダーで検索、見つかったファイルのパスをコピー、検索した文字列と同じ行にあるC列のセルに貼り付けます。

【具体的な操作内容】
セル範囲A1:A10のA1セルのフォルダーパスをコピー。
Windows Explorerのアドレスバーに貼り付けます。
Excelの画面に戻り、セル範囲B1:B100のB1セルの文字列をコピー、Windows Explorerの検索ボックスに貼り付けます *1
（Excelファイルが見つかったら）
Excelファイルのパスをコピー、C1セルに貼り付けます。
（Excelファイルが見つからなかったら）
Excelの画面に戻り、セル範囲A1:A10のA2セルのフォルダーパスをコピー、Windows Explorerのアドレスバーに貼り付けます。
Excelの画面に戻り、セル範囲B1:B100のB1セルの文字列をコピー、Windows Explorerの検索ボックスに貼り付けます。
（Excelファイルが見つかったら）
Excelファイルのパスをコピー、C1セルに貼り付けます。
・
・
・
（Excelファイルが見つからなかったら）
Excelの画面に戻り、セル範囲A1:A10のA10セルのフォルダーパスをコピー、Windows Explorerのアドレスバーに貼り付けます。
Excelの画面に戻り、セル範囲B1:B100のB1セルの文字列をコピー、Windows Explorerの検索ボックスに貼り付けます。
（Excelファイルが見つかったら）
Excelファイルのパスをコピー、C1セルに貼り付けます。

（ファイル名にB1セルの文字列を含むExcelファイルが見つかったら、B2セルも同様の操作を行います） *2

セル範囲A1:A10のA1セルのフォルダーパスをコピー。
Windows Explorerのアドレスバーに貼り付けます。
Excelの画面に戻り、セル範囲B1:B100のB2セルの文字列をコピー、Windows Explorerの検索ボックスに貼り付けます *1
（Excelファイルが見つかったら）
Excelファイルのパスをコピー、C2セルに貼り付けます。
（Excelファイルが見つからなかったら）
Excelの画面に戻り、セル範囲A1:A10のA2セルのフォルダーパスをコピー、Windows Explorerのアドレスバーに貼り付けます。
Excelの画面に戻り、セル範囲B1:B100のB2セルの文字列をコピー、Windows Explorerの検索ボックスに貼り付けます。
・
・
・
（Excelファイルが見つからなかったら）
Excelの画面に戻り、セル範囲A1:A10のA10セルのフォルダーパスをコピー、Windows Explorerのアドレスバーに貼り付けます。
Excelの画面に戻り、セル範囲B1:B100のB2セルの文字列をコピー、Windows Explorerの検索ボックスに貼り付けます。
（Excelファイルが見つかったら）
Excelファイルのパスをコピー、C2セルに貼り付けます。

（B列の最終行まで同様の操作を行います）

*1
フォルダー配下のすべてのサブフォルダーも検索します。

*2
いずれかのフォルダー内に、検索した文字列を含むExcelファイルが必ず1つ存在します。


【マクロを実行するExcelブックの情報】
現在開いているブック *1 で、セル範囲A1:A10の各セルにフォルダーパス *2 が1つずつ入力されています。
また、同ブックでセル範囲B1:B100の各セルに文字列 *3 が入力されています。

*1
ブック名：Book1.xlsx
シート名：Sheet1

*2
フォルダーパスは
A1セルにC:¥Users¥ユーザー名¥Documents¥A1
A2セルにC:¥Users¥ユーザー名¥Documents¥A2
A3セルにC:¥Users¥ユーザー名¥Documents¥A3
・
・
・
A8セルにC:¥Users¥ユーザー名¥Documents¥A8
A9セルにC:¥Users¥ユーザー名¥Documents¥A9
A10セルにC:¥Users¥ユーザー名¥Documents¥A10
と入力されています。
A列の最終行がA10セルとは限りません。
例えば、A100セル、A1000セルと変化します。

*3
文字列は
B1セルにB000001
B2セルにB000002
B3セルにB000003
・
・
・
B98セルにB000098
B99セルにB000099
B100セルにB000100
と入力されています。
B列の最終行がB100セルとは限りません。
例えば、B1000セル、B10000セルと変化します。

投稿者 : さんこう     投稿日時 : 2024/06/15(Sat) 15:25:19

---

回答ではありません。

わざわざ「Windows Explorer」を操作する必要があるとは思えませんし、

A列記載のフォルダから、ファイル名にB列記載の文字列を含んだファイルを見つけるとして、

見つけたファイルパスをどこに貼り付けるのかはっきりしません。

投稿者 : Nabejiro     投稿日時 : 2024/06/15(Sat) 16:45:17

---

ご指摘ありがとうございます。

「わざわざ「Windows Explorer」を操作する必要があるとは思えませんし」

ファイル検索の方法の一例としてエクスプローラを取り上げています。
上記の操作を手作業で行っており、マクロで自動化できればと思い、投稿させていただいた次第です。

「A列記載のフォルダから、ファイル名にB列記載の文字列を含んだファイルを見つけるとして、

見つけたファイルパスをどこに貼り付けるのかはっきりしません。」
質問内容をご確認ください。
「Excelファイルのパスをコピー、C1セルに貼り付けます」と記載しています。

投稿者 : さんこう     投稿日時 : 2024/06/15(Sat) 17:05:56

---

＞ファイル検索の方法の一例としてエクスプローラを取り上げています。

「下記の操作を実行するVBAコードをご教示いただけないでしょうか。」と書かれているので、「一例」には見えませんが。


＞質問内容をご確認ください。
＞「Excelファイルのパスをコピー、C1セルに貼り付けます」と記載しています。

C1セルに貼り付けるとして、次に見つけたものC1セルに貼り付け（上書き）るということですか。

意味ないように思いますが。

投稿者 : Nabejiro     投稿日時 : 2024/06/15(Sat) 17:31:48

---

ご返信ありがとうございます。

言葉足らずで申し訳ありません。
ファイル検索の方法にこだわりはありません。
必ずエクスプローラで検索しなければならない、というわけではございません。

質問内容の【具体的な操作内容】にも記載がありますが、ファイルのパスをC1セルに貼り付けた後、次のファイルパスはC2セルに貼り付けます。

よろしくお願いいたします。

投稿者 : さんこう     投稿日時 : 2024/06/15(Sat) 18:27:25

---

＞必ずエクスプローラで検索しなければならない、というわけではございません。

わかりました。

＞質問内容の【具体的な操作内容】にも記載がありますが、ファイルのパスをC1セルに貼り付けた後、次のファイルパスはC2セルに貼り付けます。

説明ありがとうございます。
その次は？とも思ったりしますが、検索した文字列（B列のどこか）と同じ行のC列ということにします。


ご希望通りではありませんが、参考になれば。

Dim fso As Object

Sub main()
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ra = 1
    Do While Cells(ra, "A") <> ""
        rb = 1
        Do While Cells(rb, "B") <> ""
            f = fp(Cells(ra, "A").Value, Cells(rb, "B"))
            If f <> "" Then
                Cells(rb, "C") = "ありました"
                Exit Do
            End If
            rb = rb + 1
        Loop
        ra = ra + 1
    Loop
End Sub

Function fp(fld, fil) As String
    fp = ""
    Set fd = fso.GetFolder(fld & "\")
    
    For Each fl In fd.Files
        If fl.Name Like "*" & fil & "*" Then
            fp = fl.Path
            Exit Function
        End If
    Next
       
    For Each sfd In fd.SubFolders
        
        fp = fp(sfd, fil)
        If fp <> "" Then
            Exit Function
        End If
    Next

End Function

投稿者 : マルチ     投稿日時 : 2024/06/15(Sat) 19:58:02

---

https://www.excel.studio-kazu.jp/kw/20240615135950.html?t=185409
マルチポストです

投稿者 : Nabejiro     投稿日時 : 2024/06/15(Sat) 21:34:39

---

■[返信 6] マルチさん（2024-06-15 19:58:02）の記事
＞ https://www.excel.studio-kazu.jp/kw/20240615135950.html?t=185409
＞ マルチポストです

他サイトにも投稿している旨を記載すべきでした。
申し訳ありません。

さんこう さん
ありがとうございます！
コードの内容確認、検証させていただきます。

投稿者 : マルチ     投稿日時 : 2024/06/16(Sun) 19:14:56

---

他のスレッドでは回答があるようだけど、
どちらに返事するかは自分の自由とでも思ってんの？
マルチしたって返事しないと失礼であることに変わりないですよ。
そう言う余裕もないと言うなら、最初からマルチなんてするべきじゃないよ。