ファイルの検索

今度は、所在の分からないファイルを検索してみましょう。
フォルダ内のファイル一覧の取得は以前に紹介しました。 フォルダ内のファイル一覧の取得で、配下のサブフォルダを含めたファイルの一覧の作成は紹介しましたから、 これを利用して、特定な条件のファイルを探索することに利用できるかも知れません。
ですが、FileSearchオブジェクトを利用すると、再帰処理も書かずに、しかもワイルドカードを使ってファイルの探索ができます。
このページの前半のコードは「Office 2007」以降では動きません。   Office 2007以降では、FileSearchオブジェクトそのものが「Office 2007 プログラムのファイルのマクロの検索マクロを実行すると、エラー メッセージ:ランタイム エラー 5111」ということでは正式にサポートされなくなりました。
Office 2007」以降ではどうするかという方法を、このページの後半で説明しています。
サンプルでは、ルートフォルダと探索するファイルのキーワード、最終更新日条件を設定します。
シートの上3行にこれらの条件を設定して、マクロの起動で「Sample_FileSearch」を実行して下さい。
ファイルの検索で複数ファイルが見つかった例
今回のサンプルでは、条件で見つかったファイルの一覧をシート上(5行目から)に表示するだけにしていますが、見つけたファイルに対して何かの処理を行なうのであれば、その記述改変場所が分かるようにコードを記述してあります。
ですが、私自身は実務ではFileSearchオブジェクトを利用したマクロは作ったことはありません。
このサンプルでは、最終更新日も探索条件に指定していますが、これはFileSearchオブジェクトへの条件ではなく、FileSearchオブジェクトから探索結果を受け取ってからFileSystemObject(FSO)で確認して振るっていますので誤解のないようにお願いします。

では、この機能のコードの紹介です。
FileSearchオブジェクト自体は、以前のページで紹介したFileSystemObject(FSO)のメンバではありませんが、 このサンプルでは探索したファイルの最終更新日時の取得にFileSystemObject(FSO)を使っているため、「Microsoft Scripting Runtime」の参照設定は必要です。

'*******************************************************************************
'   FileSearchのサンプル(条件に該当するものをシートに表示)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
Option Explicit

'*******************************************************************************
'   FileSearchのサンプル(条件に該当するものをシートに表示)
'   ※シート上の入力値に対する条理チェックは行なっていません。
'*******************************************************************************
Sub Sample_FileSearch()
    Dim vntF As Variant
    Dim objFS As FileSearch
    Dim objFSO As FileSystemObject
    Dim dteDate As Date
    Dim GYO As Long
    Dim cntFound As Long

    Set objFS = Application.FileSearch      ' FileSearch
    Set objFSO = New FileSystemObject       ' FSO
    Rows("5:65536").ClearContents
    GYO = 4
    With objFS
        .NewSearch
        .LookIn = Trim(Cells(1, 2).Value)   ' Search開始フォルダ
        .Filename = Trim(Cells(2, 2).Value) ' 探索ファイル式
        dteDate = DateAdd("m", Cells(3, 2).Value * -1, Date)
        .SearchSubFolders = True            ' サブフォルダも探索
        ' 処理開始
        If .Execute() <> 0 Then
            ' 見つかったファイル分のループ
            For Each vntF In .FoundFiles
                '---------------------------------------------------------------
                '    ↓↓↓この間が見つかったファイルに対する処理↓↓↓
                ' FSOにてファイルを取得
                With objFSO.GetFile(vntF)
                ' 今回は、最終更新日を確認し、該当ならシートの表示
                    If .DateLastModified >= dteDate Then
                        GYO = GYO + 1
                        Cells(GYO, 1).Value = .Name
                        Cells(GYO, 2).Value = .DateLastModified
                        Cells(GYO, 3).Value = _
                            Left(.Path, Len(.Path) - Len(.Name) - 1)
                        cntFound = cntFound + 1
                    End If
                End With
                '    ↑↑↑この間が見つかったファイルに対する処理↑↑↑
                '---------------------------------------------------------------
            Next vntF
        End If
    End With
    Set objFS = Nothing
    Set objFSO = Nothing
    ' 処理結果の表示
    If cntFound = 0 Then
        MsgBox "見つかりません"
    Else
        MsgBox cntFound & "個見つかりました"
    End If
End Sub

'----------------------------<< End of Source >>--------------------------------
(ここをクリックすると、このサンプルがダウンロードできます)
このように、単純ループ内で、最終更新日時だけFileSystemObject(FSO)を使って確認していますが、 見つかったファイルは、フルパスファイル名がvntFで受け取れるようになっているので、ファイル名だけの羅列で良ければFileSystemObject(FSO)は必要ないわけです。

上のコードはExcel2007以降では動きません。
FileSearchオブジェクトはExcel2007以降には実装されていません。
Excel2007以降では動きません。
コンパイルエラーにはならないようですが、このように実行時エラーになってしまいます。
理由は先頭のコラムに書いた通りで、マイクロソフトがFileSearchオブジェクトを廃止したからです。

FileSearchを使用しない方法は....
Microsoftは「Windows Desktop Search」を使うことを勧めているようですが、VBAでどうするのかというと参照設定に出てくるわけでもなく情報が見つかりません。 と、なるとExcel2007以降では独自に再帰動作するコードを作成しないといけないようです。
Excel2007以降ではこちらをどうぞ。
(画像をクリックすると、このサンプルがダウンロードできます)
単にFileSystemObjectを使って、フォルダ単位に再帰動作させ、フォルダ単位に存在するファイルを巡回して検索対象かどうかを判断させています。 各フォルダの全ファイルを探索して、1ファイルずつファイル名をLike判定で対象かを判断させています。

コードはこのようになりました。

'***************************************************************************************************
'   FileSearchを使わないサンプル(条件に該当するものをシートに表示)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Scripting Runtime
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 07/08/02(1.0.0)新規作成
' 17/12/02(1.1.0)*.xlsm版で再作成
' 17/12/10(1.1.0)更新日時判定を先に判断してループ内の判断文を回避
'***************************************************************************************************
Option Explicit
'===================================================================================================
' GetSystemTimeで使用する構造体
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type
'-----------------------------------------------------------------------------------------
Private g_strSearchWord As String                               ' 検索文字列
Private g_dteDate As Date                                       ' 更新日付限度
Private g_blnAllDate As Boolean                                 ' 更新日付不問
'-----------------------------------------------------------------------------------------
' ■システム時刻取得
Private Declare Sub GetSystemTime Lib "KERNEL32.dll" (lpSystemTime As SYSTEMTIME)

'***************************************************************************************************
'   ■■■ 起動処理 ■■■
'***************************************************************************************************
'* 処理名 :Sample_FileSearch3
'* 機能  :ファイル検索機能サンプルB
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2007年08月02日
'* 作成者 :井上 治
'* 更新日 :2017年12月02日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:※シート上の入力値に対する条理チェックは行なっていません
'***************************************************************************************************
Sub Sample_FileSearch3()
    '-----------------------------------------------------------------------------------------------
    Dim objFSO As FileSystemObject                                  ' FileSystemObject
    Dim lngRow As Long                                              ' 行INDEX
    Dim lngCntSearch As Long                                        ' 検索ファイル数
    Dim lngCntFound As Long                                         ' 発見ファイル数
    Dim objStrTime As SYSTEMTIME                                    ' 開始日時
    Dim objEndTime As SYSTEMTIME                                    ' 終了日時
    Dim strMSG As String                                            ' メッセージ
    Set objFSO = New FileSystemObject
    Rows("5:1048576").ClearContents
    lngRow = 4
    '-----------------------------------------------------------------------------------------------
    ' 指定値セット
    g_strSearchWord = UCase(Trim(Cells(2, 2).Value))
    If Cells(3, 2).Value <> "" Then
        g_dteDate = DateAdd("m", Cells(3, 2).Value * -1, Date)
        g_blnAllDate = False
    Else
        g_blnAllDate = True
    End If
    '-----------------------------------------------------------------------------------------------
    ' 画面描画停止
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    '-----------------------------------------------------------------------------------------------
    ' 開始日時取得
    Call GetSystemTime(objStrTime)
    ' ルートフォルダから探索開始(ファイル探索サブ処理)
    Call GP_FileSearch3Sub(objFSO, _
                           objFSO.GetFolder(Trim(Cells(1, 2).Value)), _
                           lngRow, _
                           lngCntSearch)
    ' 終了日時取得
    Call GetSystemTime(objEndTime)
    Set objFSO = Nothing
    '-----------------------------------------------------------------------------------------------
    ' 画面描画再開
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    '-----------------------------------------------------------------------------------------------
    lngCntFound = lngRow - 4
    ' 処理結果の表示
    If lngCntFound = 0 Then
        strMSG = "見つかりません"
    Else
        strMSG = lngCntFound & "個見つかりました"
    End If
    strMSG = strMSG & vbCrLf & "検索件数=" & lngCntSearch & "ファイル"
    strMSG = strMSG & vbCrLf & "処理時間=" & FP_SumProcSec(objStrTime, objEndTime) & "秒"
    MsgBox strMSG
End Sub

'***************************************************************************************************
'* 処理名 :GP_FileSearch3Sub
'* 機能  :ファイル探索サブ処理
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = FileSystemObject(Object)
'*      Arg2 = Folder(Object)
'*      Arg3 = 行INDEX(Long)
'*      Arg4 = 検索ファイル数(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2007年08月02日
'* 作成者 :井上 治
'* 更新日 :2017年12月10日
'* 更新者 :井上 治
'* 機能説明:フォルダ単位処理(再帰動作)
'* 注意事項:※エラー処置無し(サンプルなので)
'***************************************************************************************************
Private Sub GP_FileSearch3Sub(ByRef objFSO As FileSystemObject, _
                              ByVal objFolder As Folder, _
                              ByRef lngRow As Long, _
                              ByRef lngCntSearch As Long)
    '-----------------------------------------------------------------------------------------------
    Dim objFolder2 As Folder                                        ' サブフォルダ
    Dim objFile As File                                             ' ファイル
    Dim strFileU As String                                          ' ファイル名
    Dim strPath As String                                           ' フォルダ名
    '-----------------------------------------------------------------------------------------------
    ' サブフォルダの探索
    For Each objFolder2 In objFolder.SubFolders
        ' ファイル探索サブ処理(再帰動作)
        Call GP_FileSearch3Sub(objFSO, objFolder2, lngRow, lngCntSearch)
    Next objFolder2
    '-----------------------------------------------------------------------------------------------
    ' 更新日時判定使用
    If Not g_blnAllDate Then
        ' このフォルダ内のファイルの探索
        For Each objFile In objFolder.Files
            lngCntSearch = lngCntSearch + 1
            strFileU = UCase(objFile.Name)
            ' LIKE判定
            If strFileU Like g_strSearchWord Then
                ' 更新日時判定
                If objFile.DateLastModified >= g_dteDate Then
                    ' 該当ならシートの表示
                    With objFile
                        strPath = Left(.Path, Len(.Path) - Len(.Name) - 1)
                        lngRow = lngRow + 1
                        Cells(lngRow, 1).Value = .Name
                        Cells(lngRow, 2).Value = .DateLastModified
                        Cells(lngRow, 3).Value = strPath
                    End With
                End If
            End If
        Next objFile
    Else
        ' このフォルダ内のファイルの探索
        For Each objFile In objFolder.Files
            lngCntSearch = lngCntSearch + 1
            strFileU = UCase(objFile.Name)
            ' LIKE判定
            If strFileU Like g_strSearchWord Then
                ' 該当ならシートの表示
                With objFile
                    strPath = Left(.Path, Len(.Path) - Len(.Name) - 1)
                    lngRow = lngRow + 1
                    Cells(lngRow, 1).Value = .Name
                    Cells(lngRow, 2).Value = .DateLastModified
                    Cells(lngRow, 3).Value = strPath
                End With
            End If
        Next objFile
    End If
End Sub

'***************************************************************************************************
'* 処理名 :FP_SumProcSec
'* 機能  :処理秒数の算出
'---------------------------------------------------------------------------------------------------
'* 返り値 :処理秒数(Double)
'* 引数  :Arg1 = 開始日時(SYSTEMTIME)
'*      Arg2 = 終了日時(SYSTEMTIME)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2017年12月02日
'* 作成者 :井上 治
'* 更新日 :2017年12月02日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:終了日時≧開始日時であること、開始:終了間で日付が変わるケースは同月内のみ対応
'***************************************************************************************************
Private Function FP_SumProcSec(ByRef objStrTime As SYSTEMTIME, _
                               ByRef objEndTime As SYSTEMTIME) As Double
    '-----------------------------------------------------------------------------------------------
    Const cnsSecByDate As Double = 86400                            ' 1日の秒数
    Const cnsSecByHour As Double = 3600                             ' 1時間の秒数
    Const cnsSecByMinute As Double = 60                             ' 1分の秒数
    Dim dblStrTime As Double                                        ' 開始日時(シリアル値)
    Dim dblEndTime As Double                                        ' 終了日時(シリアル値)
    ' 開始日時(シリアル値)
    With objStrTime
        dblStrTime = .wDay * cnsSecByDate
        dblStrTime = dblStrTime + .wHour * cnsSecByHour
        dblStrTime = dblStrTime + .wMinute * cnsSecByMinute
        dblStrTime = dblStrTime + .wSecond
        dblStrTime = dblStrTime + .wMilliseconds / 1000
    End With
    ' 終了時刻(シリアル値)
    With objEndTime
        dblEndTime = .wDay * cnsSecByDate
        dblEndTime = dblEndTime + .wHour * cnsSecByHour
        dblEndTime = dblEndTime + .wMinute * cnsSecByMinute
        dblEndTime = dblEndTime + .wSecond
        dblEndTime = dblEndTime + .wMilliseconds / 1000
    End With
    FP_SumProcSec = dblEndTime - dblStrTime
End Function

'------------------------------------------<< End of Source >>--------------------------------------

FileSearchと異なり、この方法は指定フォルダ配下(サブフォルダ含む)の全ファイルを検索しながら、 このソースコードの記述でファイル名の「LIKE判定」で探索対象かを判断しています。

結果は上記の方法で得られるのですが....
再帰動作のプログラムを作成すれば、確かに上記の結果は得られます。
しかし、特に大量なファイル数の中からごく少数のファイルを検索するようなケースだとFileSearchに比べてかなり遅いようです。 指定フォルダ配下の全ファイルをプログラム側で順次検索して検索対象かを判断する方法なので、FileSearchのようにそもそも最初から検索対象を絞り込める方法とは異なります。
実際に質問をいただいたのですが、当方でももうExcel2003が動作する環境がないので、「反則」ですがVB.NETで代替策を探してみました。
Excel2007以降ではこちらをどうぞ。
(画像をクリックすると、このサンプルがダウンロードできます)
VB.NETでもFileSystemObjectは利用できるので、これとVB.NETでできる他の方法で処理時間を比較してみましょう。
この画像のクリックからダウンロードしたサンプルを適当なフォルダに解凍して、作成される「SearchFilesTEST1」フォルダ内の「SearchFilesTEST1.exe」を起動していただくと、この画面が表示されます。

「ファイル探索手段」の4種類は以下のような方法になります。現在、VBAでできるのは「C」だけです。
@My.Computer.FileSystem.FindInFiles
これはWeb上の検索で見つけた方法だったのですが、万単位のファイル数での検索となると生成に時間が掛かってVB.NET側のタイムアウトに掛かってしまう位です。 関心がある方があれば試していただきたいのですが「実用に耐えない」というのがこちらの判断です。
ASystem.IOの通常のファイル探索(再帰動作)+SearchPattern
System.IOのオブジェクトで標準のファイル探索方法で、FileSystemObjectと異なるのはサブフォルダ探索指定と検索ファイルパターンの指定ができることです。 Aではサブフォルダ探索指定は行なわずにプログラム側で再帰動作で探索させて、1フォルダ内のファイル探索は検索ファイルパターンを使用しています。
BSystem.IOの通常のファイル探索(非再帰動作)+SearchPattern
Aと同様の方法で、プログラム側での再帰動作は行なわずにサブフォルダ探索指定と検索ファイルパターンの指定を行なう方法です。 つまり、VBAFileSearchに相当する方法だと思います。
CFileSystemObject(VBA同様の再帰動作)+ファイル名Like判定
VBAでファイル探索に使用している「Microsoft Scripting Runtime」をVB.NETでも同様に参照設定して、 同様に各フォルダを再帰動作で探索する方法です。

なお、処理時間が表示されますが、これはファイルの探索及びテーブル格納の時間のみで、Excelシートへの展開時間は含まれていません。
FileSearchの件で比較されるのであれば、BとCの処理時間を比較してみて下さい。 処理後に表示されるのは、Excelに展開される時間は含まれていません。
当方の環境ではローカルディスク(HDD)の環境で、複数の階層のフォルダに合計で16千ファイルがあるところから、数十ファイルを探索する状態で Cは6秒強かかるのですが、Bだと0.7秒程度という速さでした。

このVB.NET環境のプロジェクトはソースコードを含めて「ファイルの検索(VisualBasic)からダウンロードできます。