サブフォルダ内を含むWindows API(FindFirstFileW)を利用したファイル検索（ファイル検索比較６）

前回はFindFirstFile関数を利用したファイル検索を検証してみた、がその際にポインタがわからないとtwitterでつぶやいたところ、色々ご指導頂いたりサイトをご紹介頂いた。

www.excellovers.com

ポインタとは関係ないがご紹介頂いたサイトでFindFirstFile関数にはUnicode版（前回使用したのはANSI版）があり、そちらでないとUnicode拡張文字が使用されたパスを正しく処理できないと記載があった。

そこで今回はFindFirstFileW関数をVBAから利用してファイル検索を実現してみたいと思います。

※基本的には前回の使い回しです。

Windows API関数仕様のお作法

API関数を使用する時は、モジュールの宣言セクションで使用する関数を宣言しておく必要があります。今回は下記の３つを使用します。

・FindFirstFile関数

・FindNextFile関数

・FindClose関数

使用する関数名ANSI版と同じですがは宣言の仕方が微妙に違いますので下記のコード欄でご確認ください。

FindFirstFile関数

FindFirstFile(lpFileName As String, lpFindFileData As Win32_Find_Data) as Long

引数	内容
lpFileName	検索したいファイルのフルパス（ワイルドカード使用可）を指定する。今回のように全ファイルを検索したい場合は、フルパスのファイル名部分を「*」と指定する。
lpFindFileData	WIN32_FIND_DATA 構造体のポインタを指定する。

返り値として検索ハンドルを返す。検索対象が見つからなかった場合は－１を返します。

FindFirstFile関数はDir関数と同じように最初の検索結果のみを返します。

FindNextFile関数

FindNextFile（hFindFile As Long, lpFindFileData As Win32_Find_Data） as Long

引数	内容
hFindFile	検索ハンドルを指定する。上述のFindFirstFile関数の返り値で取得した検索ハンドルを指定する。
lpFindFileData	WIN32_FIND_DATA 構造体のポインタを指定する。

返り値として検索ハンドルを返す。検索対象が見つからなかった場合は－１を返します。

最初にファイルを検索を行う時はFindFirstFile関数を使用しますが、上述のようにこの関数は最初の検索結果のみを返します。

そこで同じ条件で２つ目以降のファイルを検索する時はこのFindNextFile関数を使用します。

FindClose関数

FindClose（hFindFile As Long）as Long

引数	内容
hFindFile	検索ハンドルを指定する。上述のFindFirstFile関数の返り値で取得した検索ハンドルを指定する。

返り値として、関数が成功すれば０以外を、関数が失敗していれば０を返します。

オブジェクトをnothingするのと同じで使用後はちゃんとお片付けをしましょう。

お作法です。

コード

Dir関数・FileSystemObjectの時と同じで３段構成になっています。

・FileSearch・・・前処理や検索結果のセルへの転記を行う

・APISearch・・・前処理やCollectionに蓄積した検索結果を配列へ変換する

・API_Search・・・APISearch内で呼び出される。実際のFindFirstFile関数等での検索を行う。

　宣言セクション部分

Option Explicit
'###Unicode版FindFirstFile関数を使用したバージョン

Private Const Max_Path = 260
Private Const conUnicodeMaxPath As Long = Max_Path * 2 - 1   'Unicodeでのパス最大長
Private Const AlternateMaxPath As Long = 14 * 2 - 1
Private Const INVALID_HANDLE_VALUE = -1

'###################################################
'Win32API関数参照
'ファイル検索
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" _
            (ByVal lpFileName As Long, lpFindFileData As Win32_Find_Data) As Long
            
'次ファイル検索
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileW" _
            (ByVal hFindFile As Long, lpFindFileData As Win32_Find_Data) As Long
            
'検索ハンドル開放
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

'##################################################

'FindFirstFile返値用変数#####################################
'Private Type FileTime
'     LowDateTime As Long
'     HighDateTime As Long
'End Type

Private Type Win32_Find_Data
     FileAttributes As Long                       'ファイル属性
     CreationTime As Currency                  '作成日
     LastAccessTime As Currency              '最終アクセス日
     LastWriteTime As Currency                '最終更新日
     FileSizseHigh As Long                       'ファイルサイズ（上位３２ビット）
     FileSizeLow As Long                         'ファイルサイズ（下位３２ビット）
     Reserved0 As Long                           '予約済み。リパースタグ
     Reserved1 As Long                           '予約済み。未使用
     FileName(conUnicodeMaxPath) As Byte            'ファイル名
     Alternate(AlternateMaxPath)  As Byte                    '8.3形式のファイル名
End Type

上述したとおり宣言セクションで今回使用する３つの関数を宣言している。

ユーザー定義型Win32_Find_DataはFindFirstFile関数との返り値を受け取るために必要。

ここが一番ANSI版とUnicode版で変更箇所が多い。

・定数「conUnicodeMaxPath」、「AlternateMaxPath」の追加

・宣言する関数名の変更。FindFirstFile⇛FindFirstFileW。FindNextFile⇛FindNextFileW

・ユーザー定義型FileTimeの廃止
・ユーザー定義型Win32_Find_Data内変数の型宣言の変更

・CreationTime、LastAccessTime、LastWriteTimeの型をCurrency型へ変更

・FileName、Alternateの型をByte型へ変更

FileSearch

Sub FileSearch()
     Dim myVar As Variant
     Cells.Clear
     
     myVar = APISearch("C:\Users\ユーザー名\OneDrive\ドキュメント\", True)
     If UBound(myVar) <> -1 Then
          Range("A1").Resize(UBound(myVar), 1).Value = myVar
     End If
End Sub

ここでは次に紹介するAPISearch関数を呼び出して、検索開始フォルダとサブフォルダ内検索の有無を指定している。

APISearch関数は検索結果に関わらず、返り値として配列を返すようにしている。

APISearch関数の返り値に対してUbound関数を使用し、返り値が－１（空配列）であれば検索結果が０であるため処理無しとする。

何らかの検索結果がある場合は２次元配列が返ってきているので、セルサイズを合わせて一括で転記している。

ここはANSI版からの変更はありません。

APISearch関数

'------------------------------------------------------------------------
Rem APISearch関数
Rem 第１引数 FolderPath：検索対象とするフォルダパスを指定する
Rem 第２引数 SubFolderSearch：フォルダ内のサブフォルダ内を検索対象とするかどうか
Rem 返り値 見つかったファイルのフルパス一覧を２次元配列として返す。
Rem １件もファイルが見つからなかった場合は空配列を返す。
Rem　関数内sub API_Searchが溜め込んだ検索結果コレクションを配列へ転記する
'------------------------------------------------------------------------

Function APISearch(FolderPath As String, SubFolderSearch As Boolean) As Variant
     Dim myCOl As Collection
     Set myCOl = New Collection
     
     API_Search FolderPath, SubFolderSearch, myCOl
     
     Dim myItem As Variant
     
     '検索結果を蓄積していたCollectionから配列へ転記してからセルへ一括転記
     If myCOl.Count = 0 Then
          APISearch = Array()
     Else
          Dim myVar As Variant
          Dim i As Long: i = 1
          
          ReDim myVar(1 To myCOl.Count, 1 To 1)
          For Each myItem In myCOl
               myVar(i, 1) = myItem
               i = i + 1
          Next
          APISearch = myVar
     End If
End Function

APISearch関数は次に紹介するAPI_Searchがモジュールレベル変数Collectionに蓄積した検索結果を配列へと変換して外部へ返す役割を担っている。

ここもANSI版からの変更はありません。

API_Search

'-------------------------------------------------------------------------------
Rem API_Search
Rem 第１引数 FolderPath：検索対象とするフォルダパスを指定する
Rem 第２引数 SubFolderSearch：フォルダ内のサブフォルダ内を検索対象とするかどうか
Rem 第３引数 SearchFileCollection：ファイル検索結果を蓄積しているCollectionオブジェクト。
Rem ByRefで引き渡すことによって再帰処理を含めた全結果をAPISearchで参照できる。
Rem Dir関数を利用してファイル・フォルダを検索。検索結果をパブリックCollectionへ蓄積していく。
'-------------------------------------------------------------------------------

Private Sub API_Search(FolderPath As String, SubFolderSearch As Boolean, ByRef SearchFileCollection As Collection)
     Dim myFileName As String
     Dim myFolderCol As Collection
     Set myFolderCol = New Collection
     
     Dim myHndle As Long     '検索ハンドル
     Dim myCheck As Long
     Dim myFindData As Win32_Find_Data
     Dim intStLen As Long
     Dim StrFileName As String
     Dim i As Long
     Dim UnicodeFolderPath As String
     
     UnicodeFolderPath = IIf(FolderPath Like "\\*", "\\?\UNC" & Mid$(FolderPath, 2), "\\?\" & FolderPath)
     '検索ハンドルを取得。見つからない場合は「INVALID_HANDLE_VALUE」を返す
     myHndle = FindFirstFile(StrPtr(UnicodeFolderPath & "*.*"), myFindData)
     
     Do
     '検索結果が「INVALID_HANDLE_VALUE」でない場合は続行
          If Not myHndle = INVALID_HANDLE_VALUE Then
          
               'null値が何文字目にあるか検索
               'API関数ではファイル名の後ろに「Max_Path」で指定した文字数までNullが詰まっている(詰めないといけない?)。
               'VBA上の処理では不要なのでNullを特定して削除する。
               intStLen = InStr(myFindData.FileName, vbNullChar) - 1
               If intStLen > 0 Then
                    'Nullと空白を取り除いたファイル名を取得
                    StrFileName = Trim(Left(myFindData.FileName, intStLen))
                    
                    'フォルダでかつ、カレントフォルダ以外かつ上位フォルダ以外なら
                    '検索フォルダ一覧に追加
                    If StrFileName = "." Or StrFileName = ".." Then
                    ElseIf myFindData.FileAttributes And vbDirectory Then
                         myFolderCol.Add StrFileName
                    Else
                         SearchFileCollection.Add FolderPath & StrFileName
                    End If
               End If
          End If
          '検索で見つからなかった場合は０を返す
          myCheck = FindNextFile(myHndle, myFindData)
     Loop While myCheck <> 0
     
     '検索ハンドルを閉じる
     FindClose (myHndle)
          
     'サブフォルダを検索する設定の場合は
     '以下の再帰処理で全てのサブフォルダ内を検索する。
     If SubFolderSearch = True Then
          Dim myFolder As Variant
          For Each myFolder In myFolderCol
               API_Search FolderPath & myFolder & "\", True, SearchFileCollection
          Next
     End If
End Sub

中核となるAPI_Search。

FindFirstFile関数・FindNextFile関数を使用してファイルを順次検索していき、検索結果をCollectionオブジェクトへ蓄積していく。

Dir関数と同じで検索結果はフォルダ・ファイルを問わず返ってくるので、アンドビット演算でフォルダかファイルの判定を行った上で蓄積するCollectionオブジェクトを振り分けている。

１つのフォルダ内の検索が全て終わればFindClose関数で検索ハンドルを閉じている。

サブフォルダ内の検索を行う時は、おなじみの再帰処理で該当フォルダが無くなるまでAPI_Searchを繰り返す。

ANSI版からの変更はまず変数UnicodeFolderPathの追加と冒頭の検索対象フォルダの変換処理です。

FindFirstFileW関数使用時にパスの先頭に "\?\" ・"\?\UNC" を追加しておくと260 (MAX_PATH) 文字よりも長い文字をパスに指定することが出来ます。

FindFirstFileW関数の第１引数に渡す値をStrPtr関数で変換をかけています。StrPtr関数は引数に指定した文字列のポインタを返します。

まとめ

またもや「ポインタ」が出てきていますがイマイチ仕組みが理解できていません。

が一応Unicode拡張文字を含んだフォルダ内もちゃんと検索が出来るようになったので現時点ではOK。

知らないということを知ったのでそのうち、解決できるでしょう。

ご紹介頂いたサイト

www.vbalab.net

その他参考サイト