ファイルを検索する

Excelで指定したフォルダ内のファイルをピックアップする処理を書くときに使うクラスです。

FileFinder

Option Explicit
' -------------------------------------------------------------------------------
' FileFinder クラス
'     指定フォルダ内のファイルを検索するクラス
'     Find メソッドで検索を開始します
'     検索結果は OnFind イベントで処理してください
' -------------------------------------------------------------------------------

' 検索対象ファイル名の RegExp オブジェクト
Private filter As Object

' 検索対象ファイルの拡張子名の Array オブジェクト
Private extentions As Variant

' サブフォルダーも検索するフラグ
Private recursive As Boolean

' -------------------------------------------------------------------------------
' OnFind イベント
'     Find でファイルが見つかった場合に発火します
' 引数
'     file 検索で見つかった FileSystemObject.File オブジェクト
' -------------------------------------------------------------------------------
Public Event OnFind(file As Variant)

' -------------------------------------------------------------------------------
' FileSystemObject プロパティ
' -------------------------------------------------------------------------------
Public Property Get FileSystemObject() As Object
    Static fso As Object
    If fso Is Nothing Then
        Set fso = CreateObject("Scripting.FileSystemObject")
    End If
    
    Set FileSystemObject = fso
End Property

' -------------------------------------------------------------------------------
' Find
'     指定フォルダー内のファイルを検索します
' 引数
'     find_root       検索のルートフォルダー文字列を指定してください
'     file_filter     検索したいファイル名を指定してください（部分一致・正規表現可）
'     file_extentions 検索したいファイルの拡張子を指定してください
'                     例＞Excelブックを検索したい場合 Array("xls","xlsx") を指定する
'     find_subfolders サブフォルダーも検索する場合は True を指定してください
' -------------------------------------------------------------------------------
Public Sub Find(find_root As String, Optional file_filter As String = "", Optional file_extentions As Variant = Nothing, Optional find_subfolders As Boolean = True)
    ' ファイル名フィルター作成
    Set filter = CreateObject("VBScript.RegExp")
    With filter
        .Pattern = file_filter
        .IgnoreCase = True
        .Global = True
    End With

    ' 拡張子名フィルター作成
    If IsArray(file_extentions) Then
        extentions = file_extentions
    Else
        extentions = Array()
    End If
    
    ' サブフォルダーも検索するフラグ
    recursive = find_subfolders

    ' 検索実行
    Call Dive(FileSystemObject.GetFolder(find_root))
End Sub

' フォルダー内を検索する
Private Sub Dive(folder As Variant)
    ' ファイルを検索する
    Dim file As Variant
    For Each file In folder.Files
        If IsTarget(file) Then
            RaiseEvent OnFind(file)
        End If
    Next

    If recursive = False Then
        Exit Sub
    End If
    
    ' サブフォルダーを検索する
    Dim subfolder As Variant
    For Each subfolder In folder.SubFolders
        Call Dive(subfolder)
    Next
End Sub

' ファイルが検索対象か判定する
Private Function IsTarget(file As Variant) As Boolean
    IsTarget = IsTargetFile(file) And IsTargetExtention(file)
End Function

' ファイル名が検索対象か判定する
Private Function IsTargetFile(file As Variant) As Boolean
    If filter.Pattern = "" Then
        IsTargetFile = True
        Exit Function
    End If
    
    IsTargetFile = filter.Test(file.Name)
End Function

' 拡張子が検索対象か判定する
Private Function IsTargetExtention(file As Variant) As Boolean
    If UBound(extentions) = -1 Then
        IsTargetExtention = True
        Exit Function
    End If
    
    Dim extension As String
    extension = FileSystemObject.GetExtensionName(file)
    Dim ext As Variant
    For Each ext In extentions
        If StrComp(extension, ext, vbTextCompare) = 0 Then
            IsTargetExtention = True
            Exit Function
        End If
    Next

    IsTargetExtention = False
End Function

使い方

FileFinderは Findメソッド で検索パラメーターを指定します。ファイルが見つかると、見つかったファイル FileSystemObject.Fileオブジェクト を引数とした OnFindイベント を発火するので WithEventsキーワード を使ってイベントを受け取ります。WithEventsキーワード は標準モジュールでは使えません。クラスモジュールを使ってください。

Private WithEvents ff As FileFinder

Public Sub Test()
    Set ff = New FileFinder
    ff.Find "C:\test", "hoge", Array("xls", "xlsx"), True
End Sub

Private Sub ff_OnFind(file As Variant)
    Debug.Print file.Path
End Sub