VBAでファイルリストを高速に取得する関数を自作する part3

今回は以前執筆した「VBAでファイルリストを高速に取得する関数を自作する」の続編です。

f:id:Kotori-ChunChun:20190424230756p:plain

まえがき
プログラムソースコード
- ファイルリスト作成モジュール
- 検証用モジュール
仕様
検証結果
おわりに
続編

まえがき

これまでの実験では次のような事がわかりました。

fsoは安定しているが、他の方法に比べてとても遅い。
dirはfsoより数倍高速。でもUnicode文字が??に化ける。
コマンドプロンプトを使えばdir並みに高速だが、Unicode対応には遠回りな方法が必要。バックグラウンドでcmdが動くため中断することが出来ず、フリーズの恐れもあるため怖い。
フリーソフトを使えばさらに高速だが、注意事項が多いため避けたい。

www.excel-chunchun.com

つまり

安定性を求めるならfso一択
速度を求めるならコマンドプロンプトかフリーソフト

という感じでした。

このまま終わりかと思われましたが、先日[Kou(id:ExcelLover)]さんの下記の記事で、APIを使った方法があることを知りました。

www.excellovers.com

さらに[空腹おやじ (id:Z1000S)]さんからも、同じくAPIを使った手法を紹介していただきました。

z1000s.hatenablog.com

APIを使った方法なら、夢の高速で安定したファイルリスト作成関数を作ることができそうです！

ようやく時間が出来たので、私のオリジナル関数に反映してみることにしました。

プログラムソースコード

今回はUnicodeにも対応しているKouさんのコードを拝借しまして、前回（Part2）のGetFileFolderList()関数を更に魔改造してみました。

なお、API関数関連の解説は上記記事がやってくれているので、私からはの解説は省略します。

※空腹おやじ様のコードはUnicode非対応なので控えさせていただきました。

※本記事のプログラムは64bit版に対応していません。次の記事のものをお使いください。

ファイルリスト作成モジュール

GetFileFolderList関数を使えるようにするには、下記のコードを標準モジュールとして追加してください。

▶ソースコードを展開

Rem Unicode対応版ファイルリスト作成関数
Rem
Rem ■公開先
Rem
Rem えくせるちゅんちゅん
Rem 2019/04/24
Rem VBAでファイルリストを高速に取得する関数を自作するPart3
Rem https://www.excel-chunchun.com/entry/2019/04/24/215335
Rem
Rem ----------------------------------------------------------------------------------------------------
Rem
Rem ■参考資料
Rem
Rem Excelが大好きだ！
Rem 2019/03/04
Rem サブフォルダ内を含むWindows API(FindFirstFileW)を利用したファイル検索（ファイル検索比較６）
Rem https://www.excellovers.com/entry/filesearch07
Rem
Rem 空腹おやじのログと備忘録
Rem 2019/04/10
Rem VBAでFindFirstFile、FindNextFileを使ってファイルリストを取得する
Rem https://z1000s.hatenablog.com/entry/2019/04/10/145606
Rem
Rem ----------------------------------------------------------------------------------------------------
Rem
Rem ■更新履歴
Rem
Rem 2019/04/24 : 初回リリース
Rem 2019/04/26 : 4/25ブログコメントの指摘を元に修正
Rem
Rem ----------------------------------------------------------------------------------------------------
Rem
Rem ■使い方
Rem
Rem 低速なFileSystemObjectを使わずに、WindowsAPIのみを使用してファイルリストを
Rem 作成するための関数です。
Rem 私が必要とする独特な機能を搭載しています。
Rem
Rem 以下、注意事項です。
Rem
Rem 1.parentFolderは末尾に\を付けたフォルダパスを指定してください。
Rem    parentFolder :     -   :  必須  : 検索対象フォルダの末尾が\で終わるパス
Rem
Rem    末尾に\が無いと実行時エラーを発生させます。
Rem
Rem 2.AddFileとAddFolderを省略すると、何も取得されません。
Rem    AddFile      :  False  : 省略可 : ファイルを対象に含めるか
Rem    AddFolder    :  False  : 省略可 : フォルダを対象に含めるか
Rem
Rem    少なくとも検索したいどちらかをTrueにしてください。
Rem
Rem 3.SubMinとSubMaxを省略すると、直下のモノしか取得しません。
Rem    SubMin       :      0  : 省略可 : 何階層以降を探索するか（0～n、-1の時は無制限）
Rem    SubMax       :      0  : 省略可 : 何階層以前を探索するか（0～n、-1の時は無制限）
Rem
Rem    parentFolderで指定したパス直下を第0階層としてカウントします。
Rem    よって、SubMinの省略、0、-1は全て同義です。
Rem
Rem　　配下の全てのファイルを取得したい場合は、-1,-1になります。
Rem    あるいは、0,9999としても実質的に同じ結果が得られます。
Rem
Rem　　※既定値を配下全てのファイルとすると、莫大な時間がかかる恐れがあるためです。
Rem
Rem 4.戻り値ははparentFolderから見た【相対パス】になります。
Rem    絶対パスを返すようにすると、全てのモノに同一の文字列が付与されるため、
Rem    深い階層で検索を開始した時にメモリを無駄に消費するのを防ぐためです。
Rem    したがって、取り出したアイテムはparentFolderと連結してから使用します。
Rem
Rem    また、フォルダの末尾には必ず\を付与した状態で返します。
Rem    ※パス文字列からファイルとフォルダを識別できるようにするためです。
Rem
Rem 5.並び順はファイル→フォルダです。
Rem
Rem    ※たぶんエクスプローラで表示される順序とは異なります。
Rem    ※今後、仕様が変わる恐れがあります。
Rem
Rem    例
Rem      A001.txt
Rem      A002.txt
Rem      A01\
Rem      A01\B001.txt
Rem      A01\B002.txt
Rem      A01\B1001\
Rem      A01\B1001\C001.txt
Rem      A01\B1001\C002.txt
Rem      A01\B1001\C2001\
Rem      A01\B1001\C2001\001.txt
Rem      A01\B1001\C2001\002.txt
Rem      A01\B1001\C2002\
Rem      A01\B1001\C2002\001.txt
Rem      A01\B1001\C2002\002.txt
Rem      A01\B1002\
Rem      A01\B1002\C001.txt
Rem      A01\B1002\C002.txt
Rem      A01\B1002\C2001\
Rem      A01\B1002\C2001\001.txt
Rem      A01\B1002\C2001\002.txt
Rem      A01\B1002\C2002\
Rem      A01\B1002\C2002\001.txt
Rem      A01\B1002\C2002\002.txt
Rem
Rem ' GetFileFolderListサンプル
Rem Sub Sample_GetFileList_API()
Rem
Rem     Const SEARCH_PATH = "D:\test\"
Rem
Rem     Dim colPaths As Collection
Rem
Rem     Set colPaths = GetFileFolderList(SEARCH_PATH)
Rem     Debug.Print "何も取得せず", colPaths.Count
Rem
Rem     Set colPaths = GetFileFolderList(SEARCH_PATH, True)
Rem     Debug.Print "指定パスのファイルのみ取得", colPaths.Count
Rem
Rem     Set colPaths = GetFileFolderList(SEARCH_PATH, True, True)
Rem     Debug.Print "指定パスのファイルとフォルダを取得", colPaths.Count
Rem
Rem     Set colPaths = GetFileFolderList(SEARCH_PATH, True, True, 2, 2)
Rem     Debug.Print "第二階層のファイルとフォルダを取得", colPaths.Count
Rem
Rem     Set colPaths = GetFileFolderList(SEARCH_PATH, True, True, 3, -1)
Rem     Debug.Print "第三階層以下のファイルとフォルダを取得", colPaths.Count
Rem
Rem     Set colPaths = GetFileFolderList(SEARCH_PATH, True, True, -1, -1)
Rem     Debug.Print "指定パス以下の全てのファイルとフォルダを取得", colPaths.Count
Rem
Rem End Sub
Rem ----------------------------------------------------------------------------------------------------

Option Explicit

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

Rem ----------------------------------------------------------------------------------------------------
Rem Win32API関数参照
Rem ファイル検索
Rem http://chokuto.ifdef.jp/urawaza/api/FindFirstFile.html
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" _
            (ByVal lpFileName As Long, lpFindFileData As WIN32_FIND_DATA) As Long
            
Rem 次ファイル検索
Rem http://chokuto.ifdef.jp/urawaza/api/FindNextFile.html
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileW" _
            (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
            
Rem 検索ハンドル開放
Rem http://chokuto.ifdef.jp/urawaza/api/FindClose.html
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Rem ----------------------------------------------------------------------------------------------------

Rem FILETIME構造体
Rem http://chokuto.ifdef.jp/urawaza/struct/FILETIME.html
Private Type FileTime
     LowDateTime As Long
     HighDateTime As Long
End Type

Rem WIN32_FIND_DATA構造体
Rem http://chokuto.ifdef.jp/urawaza/struct/WIN32_FIND_DATA.html
Private Type WIN32_FIND_DATA
     FileAttributes As Long                     ' ファイル属性
     CreationTime As FileTime                   ' 作成日
     LastAccessTime As FileTime                 ' 最終アクセス日
     LastWriteTime As FileTime                  ' 最終更新日
     FileSizseHigh As Long                      ' ファイルサイズ（上位３２ビット）
     FileSizeLow As Long                        ' ファイルサイズ（下位３２ビット）
     Reserved0 As Long                          ' 予約済み。リパースタグ
     Reserved1 As Long                          ' 予約済み。未使用
     fileName(conUnicodeMaxPath) As Byte        ' ファイル名
     Alternate(AlternateMaxPath)  As Byte       ' 8.3形式のファイル名
End Type

Rem *******************************************************************************
Rem 指定フォルダ以下の任意の階層のファイル・フォルダをリストアップする関数
Rem *******************************************************************************
Rem パラメータ    : 既定値  :  概要  : 意味
Rem parentFolder :     -   :  必須  : 検索対象フォルダの末尾が\で終わるパス
Rem AddFile      :  False  : 省略可 : ファイルを対象に含めるか
Rem AddFolder    :  False  : 省略可 : フォルダを対象に含めるか
Rem SubMin       :      0  : 省略可 : 何階層以降を探索するか（0～n、-1の時は無制限）
Rem SubMax       :      0  : 省略可 : 何階層以前を探索するか（0～n、-1の時は無制限）
Rem SubFolder    :     ""  : 再帰用 : 当初のルートフォルダ以降のパス
Rem SubCount     :      0  : 再帰用 : 現在何階層目か
Rem PathList     : Nothing : 再帰用 : パスリスト。最終的な戻り値
Public Function GetFileFolderList(ByVal parentFolder As String, _
                                    Optional ByVal AddFile = False, _
                                    Optional ByVal AddFolder = False, _
                                    Optional ByVal SubMin As Long = 0, _
                                    Optional ByVal SubMax As Long = 0, _
                                    Optional ByVal SubFolder As String = "", _
                                    Optional ByVal SubCount As Long = 0, _
                                    Optional ByRef PathList As Collection = Nothing _
                                    ) As Collection
    
    Rem 関数突入時の初期化処理
    If PathList Is Nothing Then
        Set PathList = New Collection
        
        If Len(parentFolder) > 0 Then
            If Right(parentFolder, 1) <> "\" Then
                Err.Raise 9999, "GetFileFolderList", "パスの末尾は\で終わるようにしてください。"
            End If
        End If
    End If
    
    Dim ResFolder As Collection: Set ResFolder = New Collection
    Dim findData As WIN32_FIND_DATA
    
    Rem FindFirstFileW関数では、検索パスの先頭に "\?\"や"\?\UNC" を追加しておくと
    Rem 260 (MAX_PATH) 文字よりも長い文字をパスに指定することが出来る
    Dim UnicodeFolderPath As String
    If parentFolder Like "\\*" Then
        UnicodeFolderPath = "\\?\UNC" & Mid$(parentFolder, 2)
    Else
        UnicodeFolderPath = "\\?\" & parentFolder
    End If
    
    Rem 検索ハンドルが見つからない場合は「INVALID_HANDLE_VALUE」を返す
    Dim fileHandle As Long
    fileHandle = FindFirstFile(StrPtr(UnicodeFolderPath & "*.*"), findData)
    If fileHandle = INVALID_HANDLE_VALUE Then
        Exit Function
    End If
    
    Do
        Rem FindFirstFileではファイル名の後ろに「Max_Path」で指定した文字数までNullが詰まっている。
        Dim intStLen As Long
        intStLen = InStr(findData.fileName, vbNullChar) - 1
        If intStLen > 0 Then
            Dim sFileName As String
            sFileName = Trim$(Left$(findData.fileName, intStLen))
            
            Rem カレントフォルダ以外か上位フォルダ
            If sFileName = "." Or sFileName = ".." Then
                
            Rem フォルダ予約
            ElseIf findData.FileAttributes And vbDirectory Then
                ResFolder.Add sFileName
            Rem ファイル追加
            Else
                If AddFile And (SubMin = -1 Or SubMin <= SubCount) Then
                    Rem ※ファイルはルートパスを除いた相対パス
                    PathList.Add SubFolder & sFileName
                End If
            End If
        End If
        Rem 次のファイルが見つからなかった場合は0を返すためループ終了
    Loop Until FindNextFile(fileHandle, findData) = 0
    
    Rem 検索ハンドルを閉じる
    FindClose fileHandle
         
    Dim myFolder As Variant
    For Each myFolder In ResFolder
        Rem フォルダ追加
        If AddFolder Then
            Rem ※フォルダはルートパスを除いた相対パスで末尾は "\"
            PathList.Add SubFolder & myFolder & "\"
        End If
        Rem サブフォルダ再帰探索
        If SubCount < SubMax Or SubMax = -1 Then
            Call GetFileFolderList(parentFolder & myFolder & "\", AddFile, AddFolder, SubMin, SubMax, _
                                    SubFolder & myFolder & "\", SubCount + 1, PathList)
        End If
    Next
    
    Set GetFileFolderList = PathList
    
End Function

検証用モジュール

下記のTest_GetFileList_API_Kotoriを実行すると、API_Kotoriシートが追加されてそこにファイルリストが出力されます。

既存のシートは破壊しないので安心して実行していただけます。

▶ソースコードを展開

Option Explicit

Public Const SEARCH_PATH = "D:\test\"

'テスト用コード
Sub Test_GetFileList_API_Kotori()
    
    'ファイルリストの取得
    Dim tStart As Single, tStop As Single: tStart = Timer

    Dim colPaths As Collection
    Set colPaths = GetFileFolderList(SEARCH_PATH, True, True, -1, -1)

    tStop = Timer: Debug.Print Format$(tStop - tStart, "0.00") & " sec."
    
    Call OutputCollection(colPaths, "API_Kotori")
    
End Sub

'指定した名前のシートにコレクションの内容を書き出し
Public Sub OutputCollection(col As Collection, SheetName As String)
    
    If col Is Nothing Then Exit Sub
    If col.Count = 0 Then Exit Sub

    'シート準備
    Dim WS As Worksheet
    If SheetExists(SheetName) Then
        Set WS = ThisWorkbook.Worksheets(SheetName)
    Else
        Set WS = ThisWorkbook.Worksheets.Add
        WS.Name = SheetName
    End If
    WS.Cells.Clear
    
    'コレクションの二次元配列化
    Dim i As Long
    Dim Item As Variant
    Dim Data As Variant

    ReDim Data(1 To WorksheetFunction.Min(1000000, col.Count), _
               1 To WorksheetFunction.RoundUp(col.Count / 1000000, 0))
    
    i = 0
    For Each Item In col
        Data(1 + (i Mod 1000000), 1 + Int(i / 1000000)) = Item
        i = i + 1
    Next
    
    'シートへの出力
    WS.Cells(1, 1).Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
    
End Sub

'指定したシートが存在するか確認する。
Public Function SheetExists(SheetName As String, Optional Wb As Workbook) As Boolean
    If Wb Is Nothing Then
        If ThisWorkbook.IsAddin Then
            Set Wb = ActiveWorkbook
        Else
            Set Wb = ThisWorkbook
        End If
    End If
    
    On Error Resume Next
    Dim Dummy As Worksheet
    Set Dummy = Wb.Worksheets(Left(SheetName, 31))
    On Error GoTo 0
    
    SheetExists = Not (Dummy Is Nothing)
End Function

仕様

1.概要

GetFileFolderList関数は、ファイルまたはフォルダのリストを高速で作成するための関数です。
FileSystemObjectを使用せず、Windows APIを使うことで高速にファイルリストを作成することができます。

2.パラメータと戻り値

パラメータ	型	既定値	概要	意味
parentFolder	String	-	必須	検索対象フォルダを示すFolderオブジェクト
AddFile	Boolean	FALSE	省略可	ファイルを対象に含めるか
AddFolder	Boolean	FALSE	省略可	フォルダを対象に含めるか
SubMin	Long	0	省略可	何階層以降を探索するか（0～n、-1の時は無制限）
SubMax	Long	0	省略可	何階層以前を探索するか（0～n、-1の時は無制限）
SubFolder	String	""	再帰用	当初のルートフォルダ以降のパス
SubCount	Long	0	再帰用	現在何階層目か
PathList	Collection	Nothing	再帰用	パスリスト。戻り値

3.パラメータの詳細と注意事項

1.parentFolder

parentFolderは末尾に\を付けたフォルダパスを指定してください。

末尾に\が無いと実行時エラーを発生させます。

2.AddFileとAddFolder

AddFileとAddFolderを省略すると、何も取得されません。

少なくとも検索したいどちらかをTrueにしてください。

3.SubMinとSubMax

SubMinとSubMaxを省略すると、直下のモノしか取得しません。

parentFolderで指定したパス直下を第0階層としてカウントします。よって、SubMinの省略、0、-1は全て同義です。

配下の全てのファイルを取得したい場合は、-1,-1になります。あるいは、0,9999としても実質的に同じ結果が得られます。

※既定値を配下全てのファイルとすると、莫大な時間がかかる恐れがあるためです。

4.戻り値

戻り値はparentFolderから見た【相対パス】になります。

絶対パスを返すようにすると、全てのモノに同一の文字列が付与されるため、深い階層で検索を開始した時にメモリを無駄に消費するのを防ぐためです。

したがって、取り出したアイテムはparentFolderと連結してから使用します。

また、フォルダの末尾には必ず\を付与した状態で返します。

※パス文字列からファイルとフォルダを識別できるようにするためです。

5.戻り値の並び順

並び順はファイル→フォルダです。

※たぶんエクスプローラで表示される順序とは異なります。

※今後、仕様が変わる恐れがあります。

以下、取得例

  A001.txt
  A002.txt
  A01\
  A01\B001.txt
  A01\B002.txt
  A01\B1001\
  A01\B1001\C001.txt
  A01\B1001\C002.txt
  A01\B1001\C2001\
  A01\B1001\C2001\001.txt
  A01\B1001\C2001\002.txt
  A01\B1001\C2002\
  A01\B1001\C2002\001.txt
  A01\B1001\C2002\002.txt
  A01\B1002\
  A01\B1002\C001.txt
  A01\B1002\C002.txt
  A01\B1002\C2001\
  A01\B1002\C2001\001.txt
  A01\B1002\C2001\002.txt
  A01\B1002\C2002\
  A01\B1002\C2002\001.txt
  A01\B1002\C2002\002.txt

検証結果

気になる検証結果ですが、各種環境においての所要時間を計測してみました。

ローカルSSD
ローカルUSBメモリ
オンボロNAS
高スペックNAS

検証結果1 ローカルSSD

空腹おやじさんのVBAでFindFirstFile、FindNextFileを使ってファイルリストを取得するからcreateDataのコードを拝借して、D:\testへダミーデータを生成した環境にて計測しました。

したがってUnicode文字が含まれていない状態での検証です。

ストレージ	フォルダ数	ファイル数	ファイルシステム	平均パス文字数
Sumsung 860 EVO 1TB	310	62,200	NTFS	29.8

方法	所要時間	係数
FileSystemObject	13.66	136.6
dirステートメント	2.41	24.1
コマンドプロンプト1	1.06	10.6
コマンドプロンプト2	2.41	24.1
Win32API	0.10	1.0
フリーソフト使用	0.22	2.2

検証結果2 ローカルUSBメモリ

極々普通のUSBメモリを使用した実験です。こちらも検証データは同上

ストレージ	フォルダ数	ファイル数	備考	平均パス文字数
USBメモリ 16GB	310	62,200	FAT32	29.8

方法	所要時間	係数
FileSystemObject	117.25	488.5
dirステートメント	5.77	24.0
cmd ワンライナ	1.30	5.4
cmd Uni対応	2.99	12.5
Win32API	0.24	1.0
フリーソフト使用	0.69	2.9

検証結果3 NAS

以前も検証に使用した自宅のオンボロ低スペックNASです。

そこかしろにUnicodeファイル名が含まれています。

ストレージ	フォルダ数	ファイル数	備考	平均パス文字数
NAS RAID5	5,700	65,600	SMB1.0/？/1Gbps	106.4

方法	所要時間	係数
FileSystemObject	1480.26	55.7
dirステートメント	409.77	15.4
cmd ワンライナ	Unicode文字でクラッシュ	#VALUE!
cmd Uni対応	69.90	2.6
Win32API	30.33	1.1
フリーソフト使用	26.59	1.0

検証結果4 某Server

某サーバー・・・もとい高スペックNASです。

ストレージ	フォルダ数	ファイル数	備考	平均パス文字数
某Server RAID10	75,670	1,037,628	SMB3.0/ext4/1Gbps	84.6

方法	所要時間	係数
FileSystemObject	3200.00	11.9
dirステートメント	1004.00	3.7
cmd ワンライナ	Unicode文字でクラッシュ	#VALUE!
cmd Uni対応	フリーズ死亡	#VALUE!
Win32API	269.29	1.0
フリーソフト使用	297.61	1.1

まとめ

それぞれの性能の評価を私独自の評価基準でまとめるとこんな感じになりました。

方法	高速性	完全性	汎用性	安定性
FileSystemObject	×12～500倍	○	○	○
dirステートメント	△4～25倍	×	×	○
cmd ワンライナ	△5～10倍	×	×	×
cmd Uni対応	△3～25倍	○	×	×
Win32API	○1倍	○	△	○
フリーソフト使用	○1.1～2.8倍	○	×	△

※完全性：データに欠損や不整合がないこと。（Unicode対応）
※汎用性：環境に左右されず使えること。
※安定性：中断無しに最後まで到達すること。
ちなみに、全てMac非対応です。（Apple Scriptを使う必要があるとのこと）

完全性の観点では、dirやcmdはUnicode非対応なので×としました。

汎用性の観点では、dirやcmdやフリーソフトを使う方法は、環境次第では動かないことを確認済みなので×とし、APIはまだ問題は見つかっていませんが、検証不足なのは否めないので△としました。

安定性の観点では、コマンドプロンプトを使った方法が途中でクラッシュを起こしたり、Excelに応答を返さなくなる現象が起きたので×としました。フリーソフトの種類によってはフリーソフトも×になり得ると考えます。

ファイルリスト作成関数は様々なシステムで使用するので、高速性より他の3項目を重要視したいところですが、そうするとfsoとAPIしか残りません。

APIを使った方法は、本当に環境に依存しないのか不安が残りますが、処理速度の差は歴然。

当面はAPIで稼働させ、障害が起こったら修復またはfsoに戻すという方法で対応していくのが良さそうです。

おわりに

ついに夢のファイルリスト作成関数が完成しました。

今まで(fsoだったので)、事あるごとに数十分待たされていた仕事が、一息付く間に終わりそうな予感がします。

実際にはリストアップした結果をソートしたりワイルドカード等によりフィルタしてから使用することになりますが、その辺の関数はまた後日機会があればということで。

それにしても、これほどまでにAPIが早いと、fso.FileExistsなども高速化できるのではないかと気になりますね！　こちらも気が向いたら研究したいと思います。

続編

続きを書きました。もしよろしければ、こちらも御覧ください。

www.excel-chunchun.com

何か御座いましたらコメント欄、またはTwitterからどうぞ♪

それではまた来週♪　ちゅんちゅん(・8・)