シーゴの Excel 研究室

タイトル変更しました （旧称：今日を乗り切るExcel研究所）

トップ > VBA > 【VBA】ファイルを高速に検索したい【100本ノック】

【VBA】ファイルを高速に検索したい【100本ノック】

VBA

エクセルの神髄さんのTwitter企画 「VBA100本ノック」への便乗記事、飛びとびですが、今回は66本目。

お題：VBA100本ノック 66本目：全サブフォルダからファイルを探す

出題ページ

方針

あちこちにファイルをコピーしてどれがなんだかわからなくこと、よくありますね。 こういう、開いているブックと同名のファイルを検索するマクロを用意しておくと重宝しそうです。

お題への模範的な解答としては FileSystemObject と再帰関数を使ってフォルダ内を探索するものでしょう。

ただ、再帰プログラムを書くのは楽しいのですが、すでに多くの方の回答にあるので今回は見送り、別の方法を考えます。

ところで、この FileSystemObject の再帰的な探索は、フォルダが大きくなるととどうしても重くなるという不満があるようです。

重いといっても実用上はたいして問題ならないと思いますが、 ほんとうに検索速度が重要だとしても VBA でロジックを組む限りどんなに工夫して最適化したところで限界があります。

それならシステムに検索させた方が早いでしょう。 高速化が望めるうえプログラミングも楽になります。

「システム」とは何かと問われれば説明が難しいのですが、具体的には、CMD（コマンドプロンプト）、Shell（エクスプローラ）、PowerShell、WMI、Win32API、.Net Framework 等々、Excel の外、 Windows の OS 周りで提供されている機能を想定しています。

これらはたいていファイル検索機能も持っているので、 VBA からは外部呼び出しとして検索を実行し、結果だけを返してもらうようにします。

プログラミング問題への解答としては、ちょっとズルい感じがしなくもないですが、 Twitterでの回答や 本課題のページの解答例を見ると、 すでに再帰を使わない方法として同様のアイデアがいくつかの紹介されていますので、それもアリということで。

本記事では、ほかの解答例にまだなさそうな、「PowerShell」 と 「WMI」 を使った２つの呼び出しパターンで実装してみます。

おまけで「システムインデックス」も試してみようかと思います。

解答１：PowerShell のスクリプトを使う

Option Explicit

' PowerShell を呼び出してファイル検索する
Sub VBA100_066_ex1()
    Dim folderPath As String
    Dim findName As String
    folderPath = ActiveWorkbook.Path
    findName = ActiveWorkbook.Name
        
    If folderPath = "" Then
        MsgBox "このブックは未保存です"
        Exit Sub
    ElseIf ActiveWorkbook.Path Like "https://*" Then
        MsgBox "OneDriveのファイル検索は未対応です"
        Exit Sub
    End If

    ' ファイル名を検索してファイル情報をタブ区切りのテキストとしてクリップボードにコピーする
    Const ps = "&{ls $args[0] $args[1] -s -af|%{($_.FullName,$_.LastWriteTime, $_.Length) -join [char]0x9}|scb}"
    CreateObject("WScript.Shell") _
        .Run "powershell -c """ & ps & """ " & q(folderPath) & " " & q(findName), 0, True
    
    If Application.ClipboardFormats(1) = -1 Then
        MsgBox "ファイルは見つかりませんでした" & vbCrLf & folderPath & vbCrLf & findName
        Exit Sub
        ' オリジナルファイル自体が検索されるので、最低1個は見つかるはず
        ' ファイル名に一部特殊文字が含まれているとそれさえ見つからないことがある
    End If
    
    With ThisWorkbook.Worksheets.Add  ' 新規シート
        .Paste
        .Columns.AutoFit
        .Activate
    End With
End Sub

Private Function q(ByVal str As String) As String
    q = "'" & Replace(Replace(str, "'", "''"), "’", "’’") & "'"
End Function

解答２：WMI のクエリを使う

Option Explicit

' WNI クエリでファイル検索する
Sub VBA100_066_ex2()
    If ActiveWorkbook.Path = "" Then
        MsgBox "このブックは未保存です"
        Exit Sub
    End If
    If ActiveWorkbook.Path Like "https://*" Then
        MsgBox "OneDriveのファイル検索は未対応です"
        Exit Sub
    End If
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim spec As String
    spec = ActiveWorkbook.FullName
            
    ' ファイル検索のクエリ（WQL）を組む
    Dim query As String
    query = "select * from CIM_DataFile where" _
        & " Drive = " & q(fso.GetDriveName(spec)) _
        & " and Path like " & q(Mid(fso.GetParentFolderName(spec), 3) & "%") _
        & " and FileName = " & q(fso.GetBaseName(spec)) _
        & " and Extension = " & q(fso.GetExtensionName(spec))

    ' WMI にファイル検索のクエリを投げる
    On Error GoTo wmi_error
    Dim cimFiles As Object

    Set cimFiles = GetObject("winmgmts:\\" & "." & "\root\cimv2").ExecQuery(query)

    If cimFiles.Count = 0 Then
        MsgBox "ファイルは見つかりませんでした" & vbCrLf _
            & fso.GetParentFolderName(spec) & vbCrLf & fso.GetFileName(spec)
        Exit Sub
        ' オリジナルファイル自体が検索されるので、最低1個は見つかるはず
    End If
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets.Add ' 新規シート
    
    Dim cur As Range
    Set cur = sh.Range("A1:C1")
    
    Dim cimFile As Object
    For Each cimFile In cimFiles
        cur = Array( _
            cimFile.Name, _
            convSwDate(cimFile.LastModified), _
            cimFile.FileSize)
        Set cur = cur.Offset(1)
    Next

    sh.Columns.AutoFit
    sh.Activate
    
    Exit Sub
    
wmi_error:
    Debug.Print query
    MsgBox Err.Description
End Sub

' 日時型の変換
' https://qiita.com/nukie_53/items/ca89faede67c905912eb
Private Function convSwDate(s As String) As Date
    With CreateObject("WbemScripting.SWbemDateTime")
        .Value = s
        convSwDate = .GetVarDate(True)
    End With
End Function

Private Function q(str As String) As String
    q = "'" & Replace(Replace(str, "\", "\\"), "'", "\'") & "'"
End Function

　

　

考察

技術要素について説明します。

PowerShell

Windows PowerShell とはシステム管理などで使うあの青いコマンド画面のことです。

黒い画面のコマンドプロンプトのほうはもう使わないでほしい、というのがマイクロソフトさんからのお願いです。

上記解答例では、ファイル名を検索する PowerShell スクリプトを用意して、 poweshell コマンドを VBA 側から実行しています。

検索結果の受け渡しは、標準入出力経由でもよかったのですが、面倒なのでここではクリップボードを経由させました。

ちゃんと比較検証はしていませんが、少なくとも FileSystemObject によるよる検索よりはたしかに高速でした。 また CMD のコマンドを使った例よりも速いようです。

さて、powershell コマンドに渡している検索スクリプトは、ワンライナーに収めるためできるだけ短縮した表現になっています。

&{ls $args[0] $args[1] -s -af|%{($_.FullName,$_.LastWriteTime, $_.Length) -join [char]0x9}|scb}

慣れていないと暗号のようで分かりにくいと感じるでしょう。

ちなみに、これを短縮なしで書くと次のような感じになりますが・・・

Invoke-Command -ScriptBlock {
    Get-ChildItem -Path $args[0] -Filter $args[1] -Recurse -File | 
    ForEach-Object {
      $a = @($_.FullName, $_.LastWriteTime, $_.Length)
      $a -join "`t"
    } |
    Set-Clipboard
} -ArgumentList 'D:\folder\path', 'findName.xlsx'

ひとつも分かり易くなりませんね。 それが PowerShell 。

注意点として、ファイル名によっては検索に失敗する可能性があるようです。 検索の元にしたファイルがあるはずなので、最低１個は引っかかるはずなのですが、それさえも見つからないという状態です。

これはどうも、ファイル名に含まれる特殊な文字が原因となっているようです。 powershell のコマンドラインの制約からファイル名に含まれていると正しく検索できない特殊な文字（記号）、例えばワイルドカードに使われる[や] などがあります。

ほかにどんな特殊文字があるのか調べ切れていませんが、 実用のためにはこれらの文字をちゃんとエスケープする処理を追加する必要があるかもしれません。

WMI

WMI (Windows Management Instrumentation) もシステム管理者用の WIndows の機能で、wmic という対話的コマンドも用意されています。

WMI を使うと PC のデバイスや OS の情報、ネットワークの構成、 プロセス や イベント の状態など Windows システム上のあらゆる情報を収集できます。

そこに、ファイルとフォルダも、全てもれなく管理対象として含まれます。

WMI はそれらシステム情報を WMI リポジトリ（WMI Repository）という一種の専用データベースで管理しています。

構造化されたデータベース内の検索は、ファイルシステムのパスを地道に探索する（ CMD や PowerShell のような）より遥かに高速になるはずです。

VBA から WMI オブジェクトに渡すのは WQL（Windows Query Language）という、簡易版 SQL のような言語で書かれたクエリ文です。

上記解答プログラムの query 変数を展開すると、筆者の環境（D:\VBA100本ノック\66本目\全サブフォルダからファイルを探す.xlsm）では以下のようなクエリになります。

select * from CIM_DataFile 
where 
   Drive = 'D:' 
   and Path like '\\VBA100本ノック\\66本目%' 
   and FileName = '全サブフォルダからファイルを探す'
   and Extension = 'xlsm'

ここで、 ファイルを管理する CIM_DataFile クラスという（テーブルのような）ものからファイルプロパティを条件にデータを検索しています。 CIM_DataFile で参照できるプロパティにどんなものがあるのかは、 ドキュメントを参考にしてください。

パスのセパレータ（\）は2重（\\）にする必要があります。 フォルダ配下を検索対象とするため、like 演算子でフォルダパス（Path）の先頭一致をテストしています。

WQL エンジンによるクエリの最適化を期待していいのかわかりませんが、 もしかしたら、判定式の順序にカーディナリティを配慮したり、コストのかかる Like 文の評価を後回しにするなどしたほうが、さらにパフォーマンスの改善が望めるのかもしれません。 これも未検証ですが。

さて、WMI でも注意点があります。

WMI の情報をネット検索していると、リポジトリの修復や再構築方法の話題がけっこう目につきます。 どうも、WMI のレポジトリは壊れることがままあるようなのです。

業務アプリの検索機能に WMI を応用する場合には、要求された信頼性を満たせるのか慎重な判断が必要になるでしょう。

　

　

おまけ：システムインデックスのクエリを使う

ついでなので、システムインデックスを使った検索も試しておきます。 検証プログラムは本節の最後に掲載します。

システムインデックス

「システムインデックス」は、 Windows 標準搭載の検索エンジンである Windows Search が使用しているインデックスです。

インデックスとは、ファイル名やプロパティ（属性）、ファイルのデータから抽出された単語などからファイルへの索引として参照される 特別なデータベースです。 これにより Windows Search は検索キーワードから該当ファイルを高速に検索することができます。

Windows Search は、エクスプローラやタスクバーの検索窓からファイルを検索するときに呼ばれていて、私たちは普段から意識せずにこれを使っています。

VBA からシステムインデックスの検索するのにもいろいろ方法があるようですが、ここでは一番お手軽そうな ADO 経由の検索を試してみます。

その場合、WSSQL（Windows Search SQL） というこれまた SQL を拡張した言語によるクエリを Windows Search に投げます。

筆者のドキュメントフォルダ（C:\Users\shego\Documents）配下で EXCEL ファイル（XLSX）を検索するには以下のようなクエリになります。

select
    System.ItemPathDisplay, 
    System.DateModified,
    System.Size 
from SYSTEMINDEX 
where
    SCOPE = 'C:\Users\shego\Documents'
    and System.FileExtension = '.xlsx'

SQL の FROM 句に SYSTEMINDEX を固定で指定します。

WHERE 句の SCOPE で指定したフォルダパスの配下が検索対象となります。 フォルダ直下だけを検索したいときにはこれを DIRECTORY に代えます。

WHERE 句や出力リストに参照できるプロパティにどんなものがあるのかは ドキュメントを確認してみてください。

パフォーマンス的には、特に大量のファイルから検索する場合、WMI のときよりも高速になると期待されます。 ただ、これも実際に測定検証はしていませんのでどの程度とまでは言えませんが。

はい、ここでも注意があります。

確実に対象ファイルが存在するフォルダを検索しても、何も結果が返ってこないことがあるのです。

それにはいくつかの要因があります。

まず、Windows Search は全てのファイルをインデックス化しているわけではありません。

たとえばよくあるＣドライブやＤドライブの直下に作成した作業データのフォルダ内はデフォルトでは検索されません。 インデックスの作成は PC に負担がかかるためか、デフォルトでは必要最小限のフォルダしか登録されていないからです。

インデックス対象フォルダの追加は「インデックスのオプション」設定で設定します。 デフォルト設定では、「ユーザー」フォルダ（C:\Users）が登録されているので、ドキュメントフォルダなどユーザホーム配下のファイルなら問題なく検索できるはずです。

Windows Search は「インデックスのオプション」設定のほか、「Windowsの検索」設定（クラッシックモードか拡張モードかなど）、 ファイルシステムやエクスプローラの設定、フォルダが OneDrive などクラウドにあるのかどうか等、 様々な環境要因に左右されるので管理が難しいです。

そもそも、ここ最近 Windows Search 周りが刷新されてからは何とも不安定な状態でトラブルや不具合が多発していて、正常に検索できないことが多々あるようです。

今回のお題の解答例とせずに参考的なおまけとしたのも、PC環境によって動作を確認できない可能性があるからです。

とはいえ、安定に稼働さえすれば、システムインデックスを使う利点は大きいです。

  • Excel ファイル内の全文検索ができる
  • ファイルやフォルダが大量であっても、高速な検索ができる
  • ファイルサーバなどリモートマシンを対象に検索できる (PowerShell や WMIでも可能ですが)

以下は検証用のプログラムです。 folderPathにご自身のドキュメントフォルダなどのパスを指定して実行してみてください。

Sub システムインデックスでXLSXファイルを検索する()
    On Error GoTo error
    
    Dim folderPath As String
    ' ドキュメントフォルダならデフォルトでインデックス化されているはず
    folderPath = "C:\Users\shego\Documents"
    'folderPath = "file:c:/Users/shego/Documents" ' URL形式が正式
    'folderPath = "C:\Users\shego\OneDrive\ドキュメント" ' OneDrive

    Set adoConn = CreateObject("ADODB.Connection")
    adoConn.Open "Provider=Search.CollatorDSO;Extended Properties='Application=Windows';"

    Set adoRset = CreateObject("ADODB.Recordset")
    adoRset.Open _
        "select System.ItemPathDisplay, System.DateModified, System.Size from SYSTEMINDEX " & _
        "where SCOPE = '" & folderPath & "' and System.FileExtension = '.xlsx'", _
        adoConn
     
    adoRset.MoveFirst
    Do Until adoRset.EOF
        Debug.Print adoRset.Fields(0) ' フルパス名
        Debug.Print adoRset.Fields(1) ' 更新日時
        Debug.Print adoRset.Fields(2) ' ファイルサイズ
        adoRset.MoveNext
    Loop
    
error:
    Debug.Print Err.Description
End Sub

参考資料

関連記事

本ブログで再帰関数を使ったVBAマクロの例が以下の記事にあります。

www.shegolab.jp

www.shegolab.jp