- このページの著者ZISIRUが練習用に書いたコードです。
- 他で公開、配布、販売、使用する場合は変数名等、一部でもいいので改変して公開してください。
- 上記に違反しない限り私はすべての権利を主張しません。ご自由にお使いください。
- 本コードの使用において、この文章の表記、著者名の表記は不要です。
- 本コードは「現状のまま」提供され、明示または黙示を問わず、商品性、特定目的への適合性、非侵害に対する保証を含むがこれらに限定されない、いかなる種類の保証もありません。いかなる場合も、著者または著作権保有者は、契約行為、不法行為、またはその他の行為にかかわらず、本コード、または本コードの使用もしくはその他の取り扱いから生じる、またはそれに関連するいかなる請求、損害、またはその他の責任についても責任を負わないものとします。
- The code on this page was written by the author, ZISIRU, for practice purposes.
- If you wish to publish, distribute, or sell the code elsewhere, please modify it, even if only in terms of variable names, before making it public.
- As long as the above is not violated, I do not claim any rights and you are free to use it.
- There is no need to include this statement or the author’s name when using this code.
- This code is provided “as is”, and no warranties of any kind are offered, including but not limited to warranties of merchantability, fitness for a particular purpose, or non-infringement, whether expressed or implied. In no event shall the author or copyright holder be liable for any claims, damages, or other liabilities arising from or related to the use of this code, regardless of whether they are based on contract, tort, or other legal theory.
毎回書くと結構面倒なコードはクラスモジュールにしておくと楽です。
右は各メンバーの使い方になります。
この例のクラスモジュール名は ファイル探索_
になっています。
使いやすいように変更してください。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 |
Option Explicit '---------------------------------------------------------------------------------------------------------------- '検索語句を 【ファイル名】に、検索するフォルダパスを 【パス】に '検索結果が 【ファイル名とパス】で連想配列で取得、 keyにフルパス、 itemにファイル名 '---------------------------------------------------------------------------------------------------------------- Private ファイル名_ As String Private パス_ As String Private 拡張子コレクション_ As Collection Private ファイル名とパス_ As Dictionary Property Let パス(path As String) パス_ = path End Property Property Let ファイル名(f_name As String) ファイル名_ = f_name End Property Property Let 拡張子コレクション(coll As Collection) Set 拡張子コレクション_ = coll End Property Property Get ファイル名とパス() As Dictionary Set ファイル名とパス = ファイル名とパス_ End Property Private Sub Class_Initialize() Set ファイル名とパス_ = New Dictionary Set 拡張子コレクション_ = New Collection End Sub Sub ファイル名パス取得プロシージャ() Call 再起(パス_) End Sub Private Sub 再起(aaa As String) Dim fso As Object Dim ファイルs As Object Dim fファイル As Object Dim サブフォルダs As Object Dim fサブフォルダ As Object Dim 取出 As Variant Set fso = New FileSystemObject On Error Resume Next Set ファイルs = fso.GetFolder(aaa).Files If ファイルs Is Nothing Then MsgBox "ファイルがありません" Exit Sub End If On Error GoTo 0 If 拡張子コレクション_.Count > 0 Then For Each fファイル In ファイルs For Each 取出 In 拡張子コレクション_ If InStr(1, fファイル.name, 取出, vbTextCompare) > 0 And _ InStr(fファイル.name, "~$") = 0 And _ InStr(1, fファイル.name, ファイル名_, vbTextCompare) > 0 Then ファイル名とパス_.Add fファイル.path, fファイル.name End If Next 取出 Next fファイル Set サブフォルダs = fso.GetFolder(aaa).SubFolders For Each fサブフォルダ In サブフォルダs If fサブフォルダ.name <> "" Then For Each 取出 In 拡張子コレクション_ If InStr(1, fサブフォルダ.name, 取出, vbTextCompare) > 0 And _ InStr(fサブフォルダ.name, "~$") = 0 And _ InStr(1, fサブフォルダ.name, ファイル名_, vbTextCompare) > 0 Then ファイル名とパス_.Add fサブフォルダ.path, fサブフォルダ.name End If Next 取出 Call 再起(fサブフォルダ.path) End If Next fサブフォルダ Set fso = Nothing Set ファイルs = Nothing Set fファイル = Nothing Set サブフォルダs = Nothing Set fサブフォルダ = Nothing Set 取出 = Nothing Else For Each fファイル In ファイルs If InStr(fファイル.name, "~$") = 0 And _ InStr(1, fファイル.name, ファイル名_, vbTextCompare) > 0 Then ファイル名とパス_.Add fファイル.path, fファイル.name End If Next fファイル Set サブフォルダs = fso.GetFolder(aaa).SubFolders For Each fサブフォルダ In サブフォルダs If fサブフォルダ.name <> "" Then If InStr(fサブフォルダ.name, "~$") = 0 And _ InStr(1, fサブフォルダ.name, ファイル名_, vbTextCompare) > 0 Then ファイル名とパス_.Add fサブフォルダ.path, fサブフォルダ.name End If Call 再起(fサブフォルダ.path) End If Next fサブフォルダ Set fso = Nothing Set ファイルs = Nothing Set fファイル = Nothing Set サブフォルダs = Nothing Set fサブフォルダ = Nothing Set 取出 = Nothing End If End Sub |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
Option Explicit Sub test() Dim ファイル探索 As ファイル探索_ Set ファイル探索 = New ファイル探索_ ファイル探索.拡張子コレクション '検索する拡張子の文字列として使えます、collectionを渡してください ファイル探索.ファイル名 '検索するファイル名をstring型で渡してください(一部でも可 ファイル探索.パス '検索するフォルダのパスをstring型で渡してください ファイル探索.ファイル名パス取得プロシージャ '実行メソッドです ファイル探索.ファイル名とパス.Item '見つかったファイル名が入っています ファイル探索.ファイル名とパス.Key 'ファイルのフルパスが入っています End Sub |
以下は使用例と標準モジュールのコードになります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
Option Explicit '---------------------------------------------------------------------------------------------------------- 'テキストボックスで検索語句を取得、ダイアログでフォルダパスを取得して '【ファイル検索】クラスでサブフォルダ以下まで再起検索 'ファイル名とパスが連想配列で返ってくるのでセルに出力してハイパーリンク処理 '---------------------------------------------------------------------------------------------------------- Sub 検索() Dim フォルダパス As String Dim wsh As Object 'デスクトップパス取得で使用 Set wsh = CreateObject("WScript.Shell") With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = wsh.SpecialFolders("Desktop") '初期パスはここで変更 If Not .Show Then Exit Sub フォルダパス = .SelectedItems(1) End With Dim ファイル探索 As ファイル探索_ Dim 結果 As Long Set ファイル探索 = New ファイル探索_ If S1.Shapes("テキスト ボックス 1").TextFrame.Characters.Text = "" Then 結果 = MsgBox("検索する名前が入っていません、すべてのファイルを出力しますか?", vbYesNo) If 結果 = vbNo Then Exit Sub End If ' Dim a As Collection ' Set a = New Collection ' a.Add ".xlsm" 'addに検索する拡張子を追加 ' ' ファイル探索.拡張子コレクション = a ファイル探索.パス = フォルダパス ファイル探索.ファイル名 = S1.Shapes("テキスト ボックス 1").TextFrame.Characters.Text ファイル探索.ファイル名パス取得プロシージャ Dim 最終行 As Long Dim 出力 As Variant 最終行 = S1.Cells(Rows.Count, 1).End(xlUp).Row If 最終行 > 2 Then S1.Rows("3: " & 最終行).Delete End If |
コメント