えくせるちゅんちゅん

ことりがエクセルをちゅんちゅんするブログ

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

今回は前回の「VBAでファイルリストを高速に取得する関数」に改良を加えて更に高速化すると共に64bit対応に成功しましたのでその軌跡を記します。


まえがき

前回はWindows APIを使用することで、様々なリスクを解消しつつFileSystemObjectの数十倍の速度でファイルリストを作成する関数の開発に成功しました。

www.excel-chunchun.com


早速アドインの関数を置き換えをしたのですが…あのままでは64bitには対応していないことが判明しました。

具体的に言うとExcelが落ちます。それはもう。無言で。静かに。あっけなく。

ここで結論を言ってしまうと、関数の戻り値の型指定がLongLongPtrに変えてなかったからです。

それだけなら元の記事をコソっと直すだけのつもりでいました。

しかし、ヒントを求めて検索を繰り返しているうちに、FindFirstFileExという関数を発見。

そして気になるコメントが・・・。

https://kkamegawa.hatenablog.jp/entry/20100918/p1

長い間、NTFSチューニングの一つに「短いファイル名を生成させない」という技がありました。Windows Server 2008 R2のベストプラクティスアナライザーでも遅いディスクに対してはこのアドバイスが下されます。 NTFS Performance with Numerous Long Filenames とはいっても、短いファイル名の生成をやめると、どうしても互換性の問題が発生します。短いファイル名を意図的に使っている場合もあります。空白ファイル名使うときめんどくさいですしね…。じゃあ、OSのほうでなんとかすればいいじゃないってことで、遅まきながらWindows 7でフラグが追加されることになりました。FindExInfoBasicを指定すれば、短いファイル名をWIN32_FIND_DATA構造体に格納せず、少し早くなると書かれています。

手元の環境で81%くらいの時間になりました。

つまり、短いファイル名(8.3形式のファイル名cAlternateFileName)の取得を省略することで、さらなる高速化が見込めるみたいです。

これはやってみるしかない!!!

というわけで、今回はFindFirstFileExW関数を使って、ファイルリストの作成に挑戦します。

また、StrCmpLogicalW関数も取り入れて、ファイルリストの順序をエクスプローラと同じ並び順になるようにソートした状態で取得できないか、試したいと思います。


FindFirstFileExW 関数

参考資料

FindFirstFileExW の使用にあたって、私の語学力ではMSDNの説明が理解できなかったので、この辺りの記事も参考にしつつ情報を整理しました。

Yahooブログ 特になし - FindFirstFileEx

Excel VBA質問箱 IV - 【58244】Re:再帰処理でのファイル検索

GitHub - kumatti1/Module1.bas


概要

FindFirstFileExW 関数

HANDLE FindFirstFileExW(
  LPCWSTR            lpFileName,
  FINDEX_INFO_LEVELS fInfoLevelId,
  LPVOID             lpFindFileData,
  FINDEX_SEARCH_OPS  fSearchOp,
  LPVOID             lpSearchFilter,
  DWORD              dwAdditionalFlags
);

lpFileName

検索したいファイル名の文字列をワイルドカードで指定

FindFirstFileと同様。

先頭に "\?\"や"\?\UNC" を追加しておくとMAX_PATHよりも長い文字をパスに指定することが出来る。

例:"\\?\C:\hoge\*"

fInfoLevelId

返されるデータの情報レベルを表す FINDEX_INFO_LEVELS 列挙型を指定

基本的にはFindExInfoBasic を指定しておけばOK

lpFindFileData

検索結果のファイル情報を格納するWIN32_FIND_DATA 構造体を指定

FindFirstFileと同様

fSearchOp

ワイルドカードとの照合以外のフィルタ処理タイプを表すFINDEX_SEARCH_OPS 列挙型を指定

FindExSearchNameMatchを指定する

lpSearchFilter

検索条件へのポインタを指定

FindExSearchNameMatchの時はNULLにしろとのこと。

つまりVBAでは0&でOK

dwAdditionalFlags

補足的な検索制御フラグ。

収集した情報をまとめると、

Private Const FIND_FIRST_EX_CASE_SENSITIVE = 1& 検索では大文字と小文字が区別されます。

Private Const FIND_FIRST_EX_LARGE_FETCH = 2& ディレクトリー照会にはより大きなバッファーを使用します。 これにより、検索操作のパフォーマンスが向上する可能性があります。 Windows Server 2008Windows VistaWindows Server 2003、およびWindows XP: この値は、Windows Server 2008 R2およびWindows 7まではサポートされていません。

Private Const FIND_FIRST_EX_ON_DISK_ENTRIES_ONLY = 4& 結果を物理的にディスク上にあるファイルに制限します。 このフラグは、ファイル仮想化フィルタが存在する場合にのみ関係します。

という感じです。

戻り値

FindFirstFileと同様

成功したらファイルハンドルを返す。

見つからない場合はINVALID_HANDLE_VALUEを返す。

WindowsXPExcel 2007で実行した場合も、INVALID_HANDLE_VALUEが返却された。

WIN32_FIND_DATA 構造体

 typedef struct _WIN32_FIND_DATAA {
   DWORD    dwFileAttributes;
   FILETIME ftCreationTime;
   FILETIME ftLastAccessTime;
   FILETIME ftLastWriteTime;
   DWORD    nFileSizeHigh;
   DWORD    nFileSizeLow;
   DWORD    dwReserved0;
   DWORD    dwReserved1;
   CHAR     cFileName[MAX_PATH];
   CHAR     cAlternateFileName[14];
   DWORD    dwFileType;
   DWORD    dwCreatorType;
   WORD     wFinderFlags;
 } WIN32_FIND_DATAA, *PWIN32_FIND_DATAA, *LPWIN32_FIND_DATAA;

FINDEX_INFO_LEVELS 列挙型

typedef enum _FINDEX_INFO_LEVELS {
FindExInfoStandard,
FindExInfoBasic,
FindExInfoMaxInfoLevel
} FINDEX_INFO_LEVELS;

FindExInfoStandard : FindFirstFileと同じ動作になる。

FindExInfoBasic : WIN32_FIND_DATAのcAlternateFileNameに短いファイル名(8.3形式)を取得しない。Windows7以降対応。

FindExInfoMaxInfoLevel : 検証用らしい。This value is used for validation. Supported values are less than this value.

8.3形式のファイル名なんて今どき必要ないですから、FindExInfoBasicにしておくのが無難です。

これがFindFirstFileよりもFindFirstFileExのほうが高速化できる理由です。

FINDEX_SEARCH_OPS 列挙型

 typedef enum _FINDEX_SEARCH_OPS {
 FindExSearchNameMatch,
 FindExSearchLimitToDirectories,
 FindExSearchLimitToDevices,
 FindExSearchMaxSearchOp
 } FINDEX_SEARCH_OPS;

FindExSearchNameMatch : 指定したファイル名と一致するファイルを検索

色々調べてみましたが、他の値はいずれも未サポートだったり、利用不能だったりという検証結果しか見つかりませんでした。

実質FindExSearchNameMatch固定です。

使用例

以上をまとめると、ソースコードはこんな感じになります。

Dim findData As WIN32_FIND_DATA
Dim fileHandle As LongPtr
fileHandle = FindFirstFileEx( _
    StrPtr("\\?\C:\hoge\*"), _
    FindExInfoBasic, _
    findData, _
    FindExSearchNameMatch, _
    0&, _
    FIND_FIRST_EX_LARGE_FETCH)


StrCmpLogicalW関数

概要

エクスプローラと同じファイル順に並び替えるのに必要な関数です。

int StrCmpLogicalW(
  PCWSTR psz1,
  PCWSTR psz2
);

lpStr1

1つ目のファイルパス

lpStr2

2つ目のファイルパス

戻り値

二つのファイル名が降順だと1、同じなら0、昇順なら-1を返す

2つの文字列を比較して結果を教えてくれるだけのシンプルな関数です。

ファイル一覧、フォルダ一覧が取得できるたびに回していくことになります。

使用例

ソート関数は下記のものを参考にしました。

http://hk29.hatenablog.jp/entry/2018/03/10/183447

Sub StrCmpLogical_Sort(ByRef Arr() As String)
    Dim i As Long, j As Long
    Dim tmp As String

    For i = LBound(Arr) To UBound(Arr)
        For j = i To UBound(Arr)
            If StrCmpLogicalW(StrConv(Arr(i), vbUnicode), _
                              StrConv(Arr(j), vbUnicode)) > 0 Then
                Let tmp = Arr(i)
                Let Arr(i) = Arr(j)
                Let Arr(j) = tmp
            End If
       Next
    Next
End Sub

疑問

注意したいのはこの記述

If StrCmpLogicalW(StrConv(myArray(i), vbUnicode), _
                  StrConv(myArray(j), vbUnicode)) > 0 Then

検索すると次のようにStrPtrを使って書かれているサイトが有りました。

[半角チルダ - ■XPエクスプローラ風「数値順」ソート

If StrCmpLogicalW(StrPtr(myArray(i)), _
                  StrPtr(myArray(j))) > 0 Then

ところが、この方法だと、実行するたびに並び順がランダムに変わるのです。

2013年の記事なので、昔で仕様が変わったのでしょうか。

何故このような現象が起こるのか、まだ研究できていません。


ファイルを返す順番については下記のサイトの解説が参考になりそうです。

Office TANAKA - ファイルの一覧を取得する


ソースコード

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

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


検証用モジュール

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

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

ソートテストのための下準備用の関数(任意)

Rem ソートテスト用ファイル生成
Public Sub Test_FileCreate()
    Dim fso As FileSystemObject: Set fso = New FileSystemObject
    Dim Arr As Variant
    Arr = VBA.Array("X10Y1", "X10Y10", "X10Y2", "X1Y1", _
                    "X1Y10", "X1Y2", "X2Y1", "X2Y10", "X2Y2")
    Dim Fol As String
    Fol = "C:\Test\Sort\"
    On Error Resume Next
    fso.createFolder Fol
    On Error GoTo 0
    
    Dim i As Long
    For i = LBound(Arr) To UBound(Arr)
        fso.CreateTextFile Fol & Arr(i)
    Next
End Sub

一応こんな感じでソートされるのを確認しました。

Before After
X10Y1 X1Y1
X10Y10 X1Y2
X10Y2 X1Y10
X1Y1 X2Y1
X1Y10 X2Y2
X1Y2 X2Y10
X2Y1 X10Y1
X2Y10 X10Y2
X2Y2 X10Y10


検証結果

FindFirstFileEx関数導入後

まずはソート機能を追加する前ですが、このような結果になりました。

参考にした記事と同じで80%前後の高速化ができています。

媒体/パス File Folder 試行回数 FindFirstFile FindFirstFileEx 高速化率
SSD C:\Windows\ 149369 32303 1 7.59 6.13 81%
SSD D:\ 82213 441 50 7.52 6.64 88%
USBメモリ 62200 310 50 6.45 5.66 88%
NAS 65600 5846 1 29.18 21.23 73%

StrCmpLogicalW関数ソート導入後

コレクションのソート関数が重すぎるようで、完全に失敗しました。

原因はアイテムをインデックスで指定しているからですね。

でもインデックス指定じゃないとSwap出来ない気がします。

一旦配列変数に変換して処理するくらいしか今の所思いつきません。

とりあえず今回は断念しました。


なお、本記事のGetFileFolderList関数の仕様や解説については、前の記事で説明しておりますので必要な場合はこちらを参照願います。

www.excel-chunchun.com


おわりに

前回の関数から次の点が改良されました。

  • 64bit版Officeに対応
  • APIを変更して高速化(Windows7以降)

しかしファイルリストのソートは解決できませんでした。

ファイルリスト作成の旅は、もう少しだけ続きそうです。



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

週1回の更新を目指して、頑張ってますので応援よろしくおねがいします!

それではまた明日♪ ちゅんちゅん(・8・)