[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『【VBA】指定した文字列を各フォルダーで検索、見つかったファイルのパスをコピー、検索した文字列と同じ行にあるC列のセルに貼り付けます。』（Nabejiro）
下記の操作を実行する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 フォルダー配下のすべてのサブフォルダーも検索します。
【マクロを実行するExcelブックの情報】
現在開いているブック *1 で、セル範囲A1:A10の各セルにフォルダーパス *2 が1つずつ入力されています。
また、同ブックでセル範囲B1:B100の各セルに文字列 *3 が入力されています。
＜ 使用 Excel：Microsoft365、使用 OS：Windows10 ＞
Book1.xlsx ← ここにマクロ書くなら、マクロブックとして要、再保存 拡張子は xlsm かと＾＾
Sheet1
|[A] |[B]
[1] |C:\Users\ユーザー名\Documents\A1 |B0000001
[2] |C:\Users\ユーザー名\Documents\A2 |B0000002
[3] |C:\Users\ユーザー名\Documents\A3 |B0000003
[4] |C:\Users\ユーザー名\Documents\A4 |B0000004
[5] |C:\Users\ユーザー名\Documents\A5 |B0000005
[6] |C:\Users\ユーザー名\Documents\A6 |B0000006
[7] |C:\Users\ユーザー名\Documents\A7 |B0000007
[8] |C:\Users\ユーザー名\Documents\A8 |B0000008
[9] |C:\Users\ユーザー名\Documents\A9 |B0000009
[10]|C:\Users\ユーザー名\Documents\A10|B0000010
[11]|C:\Users\ユーザー名\Documents\A11|B0000011
[12]|C:\Users\ユーザー名\Documents\A12|B0000012
[13]|C:\Users\ユーザー名\Documents\A13|B0000013
[14]|C:\Users\ユーザー名\Documents\A14|B0000014
[15]|C:\Users\ユーザー名\Documents\A15|B0000015
[16]| |B0000016
[17]| |B0000017
[18]| |B0000018
↓
どこまで続くかは不明。。。^^;恐ろしいですね。。
でも多分そんなにたくさんでは無いのでしょうね
他アプリ操作は至難の業なのでエクスプローラ使用は断念された方が
良いかもしれません。他にもっと簡単な方法がたくさん有りますよ。
全てC:\Users\ユーザー名\Documents 以降なら
C:\Users\ユーザー名\Documentsの全てのサブフォルダを含むファイル名を取得して
B列のファイル名と照合すればＯＫかもですね。
でわ
m(_ _)m
（隠居） 2024/06/15(土) 18:42:09
要するに、特定の文字列を複数のフォルダ（その配下のサブフォルダを含む）の配下の Excelファイルの中から全文検索し、存在したらそのフルパスをシートに書き出すということですね。 ・A列に検索すべきフォルダ群、 ・B列に対象とする文字列、 ・C列に、B列の文字列を含むファイルのフルパスを書き込む ということですね。
Explorerで検索ということは全文検索なんですよね。
ExplorerはVBAからは操作できないので、その方向での対応は難しいでしょう。 （A列のフォルダ群を一つのフォルダの配下にコピーすれば、検索A列フォルダの数を n とすると 検索するコストは 1/ n になりますから、"手作業"の労力は減らせますけれども）
【質問】
(1)そもそもそうしたタスクはどういう経緯で発生したのでしょう。
(余り議論になったことがない話ですね。）
それらの事情を説明されることで、それが解決につながるヒントになる可能性があるかも
しれないので、質問しています。
(2)文字列がマッチするブックはなぜ一つだけ、と判明しているのですか？
primary keyのようなものですか？ （そうであれば普通はブック名などに埋め込むのが普通ですが）
(3)そのブックは形式が定まったもの想像しますが、いかがですか。
対象となる文字列があるセルにあることが決まっているといった幸運があれば、
各ファイルから、それらの情報を先に抽出しておいてから検索することが可能です。
(4)その文字列があるのは、セルにあるものと限定して構いませんか？
テキストボックスとかコメント、図形内の文字とか、メモとかも考慮必要ですか？
(Explorerはこの点優秀で、すべてカバーしています）
（xyz） 2024/06/15(土) 18:54:09
ファイル名のなかの文字列ということなら、以下のとおりです。 （xyz） 2024/06/15(土) 15:35:19 に投稿してその後削除したものの再投稿です。
試作品です。十分チェックしていません。 マッチするファイルは、一つだけという前提です。 （複数あっても、最初にマッチしたらもうその文字列はチェックしません）
そちらでよくチェックしてください。
<<以下、コードです>>
Option Explicit Dim dic As Object Dim fso As Object
Sub test()
Dim file As Object
Dim lastRowA&
Dim lastRowB&
Dim j&, k&
Set dic = CreateObject("Scripting.Dictionary")
Set fso = CreateObject("Scripting.FileSystemObject")
lastRowA = Cells(Rows.Count, "A").End(xlUp).Row
lastRowB = Cells(Rows.Count, "B").End(xlUp).Row
For k = 1 To lastRowB
dic(Cells(k, "B").Value) = k
Next
For j = 1 To lastRowA
checkFileName Cells(j, "A").Value
Next
Set fso = Nothing
End Sub
Sub checkFileName(folderPath As String)
Dim folder As Object
Dim file As Object
Dim e
For Each folder In fso.GetFolder(folderPath).SubFolders
checkFileName folder.Path
Next
For Each file In fso.GetFolder(folderPath).files
For Each e In dic
If InStr(file.Name, e) > 0 Then
Cells(dic(e), "C") = file.Path
dic.Remove e
End If
Next
Next
End Sub
（xyz） 2024/06/15(土) 21:05:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.