今回は巷で話題になっていたVBAのファイルリスト作成について、既存の関数の高速化を目指して私の調査した結果を報告します。
初めに
Dirはfsoより高速…？
先日、私のいつも読ませて頂いているinformentさんが掲載した下記の記事に、このような記述がありました。
Dir関数が高速でお手軽である一方、FileSystemObjectは遅いが高機能、ということらしい。個人的には、FileSystemObjectの方が好みだ。
もちろん私もfsoのほうが好きです。Dirは大嫌いです。
でもファイルリストを取得するような頻繁に使う処理は、汎用モジュールに関数として実装しておき、普段は中身を気にせずに呼び出すのが一般的です。
だから、多少可読性を犠牲にしてでも、高速化出来るのならDirでも良いのではないかと考えました。
すでに私はfsoのあまりの遅さに痺れを切らして、安定性を捨ててまで超高速なフリーソフトに逃げている場面もあったので、Dirはfsoより高速というのはまさに寝耳に水でした。
検証方法
それではfsoが遅いというのは、どれくらい遅いのでしょうか？
私の中ではフリーソフトより100倍くらい遅いという認識でしたが、ちゃんと比較したことはなかったので検証してみることにしました。
今回は次の方法の速度を比較することにします。
- Dirを使った方法
- FileSystemObjectを使った方法
- フリーソフトを使った方法
検証環境
次に検証環境ですが、私が想定しているのはネットワーク上のサーバーのファイルリストを取得する場合です。
本来なら膨大なファイルが格納されている職場のサーバーで試したいところですが、負荷実験をしたところで犯人がバレなければ何も言われないと思うが、 今回は自宅のファイルサーバーを使って検証します。
一応、変なところがボトルネックにならないように、自宅では最高スペックのPCで試してみます。
サーバースペック
| 項目 | スペック |
|---|---|
| 型番 | CRIB35NAS |
| ストレージ | HDD 3TBx4 RAID5（7TB使用済） |
| ファイル数 | 65,600 |
| フォルダ数 | 5,700 |
| SMB Version | SMB1.0 |
| 通信速度 | 1Gbps |
クライアントスペック
| 項目 | スペック |
|---|---|
| OS | Windows10 Pro 1703 64bit |
| CPU | Intel Core i7 4790K 4.0GHz |
| Excel | Office365 Solo 16.0.11029.20045 |
通信状況
ストレージがRAID5ということもあって、ランダムアクセスは絶望的なまでに遅いです。
自分用かつアーカイブ用なので、スペック的にはこれで十分なのですが。
もうお古なので早々に買い替えたいです。次はもうちょっとマトモなNASを買おう。
しかもSMB1.0にしか対応していないので、職場のサーバーとどれほど差があるのかとっても気になります。
-----------------------------------------------------------------------
CrystalDiskMark 3.0.3 (C) 2007-2013 hiyohiyo
Crystal Dew World : http://crystalmark.info/
-----------------------------------------------------------------------
* MB/s = 1,000,000 byte/s [SATA/300 = 300,000,000 byte/s]
Sequential Read : 54.520 MB/s
Sequential Write : 38.784 MB/s
Random Read 512KB : 19.314 MB/s
Random Write 512KB : 16.149 MB/s
Random Read 4KB (QD=1) : 0.648 MB/s [ 158.2 IOPS]
Random Write 4KB (QD=1) : 3.160 MB/s [ 771.5 IOPS]
Random Read 4KB (QD=32) : 0.585 MB/s [ 142.9 IOPS]
Random Write 4KB (QD=32) : 2.400 MB/s [ 585.9 IOPS]
Test : 1000 MB [Z: 85.8% (7188.4/8380.6 GB)] (x5)
Date : 2019/01/03 15:09:50
ファイルリスト作成実験
コレクションをシートに書き出す関数
概要
さて各種関数を公開する前に、ファイルリストがちゃんと作成できているか確認できるように、コレクションをシートに書き出す関数を紹介します。
後々のコードでは使用しませんが、実際に使うときにはテストする必要があると思いますので、参考にしてください。
※getFilelistRecursivelyは後で説明するDirでファイルリストを取得する関数です。
コード
'Collectionをセル出力用の2次元配列に変換する関数 Public Function CollectionToArray2(list As Collection) As Variant If list Is Nothing Then CollectionToArray2 = Empty ElseIf list.Count = 0 Then CollectionToArray2 = Empty Else Dim i As Long ReDim Data(1 To list.Count, 1 To 1) For i = 1 To UBound(Data, 1) Data(i, 1) = list(i) Next CollectionToArray2 = Data End If End Function 'コレクションを取得してアクティブシートのA列に書き出すテスト Sub test_CollectionToArray2() Dim Col As Collection Set Col = getFilelistRecursively("Z:\") Dim Data As Variant Data = CollectionToArray2(Col) If Not IsEmpty(Data) Then ActiveSheet.Cells(1, 1).Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data End If End Sub
Dirを使った方法
概要
なんと、ちょっと「あるといいな♪」と呟いただけなのですが、いつもお世話になっている H氏 がコードを書いてくれました。
そうかDirの方がfsoよりも高速なら、今まで使ってた複数階層のファイルリスト作成関数もdirバージョンを作るのもアリのような気がしてきた。
— ことりちゅん@えくせるちゅんちゅん (@KotorinChunChun) January 2, 2019
せっかくなので、GitHubに公開されているこちらのコードをお借りして、少し手を加えさせていただきました。
本当にありがとうございます。
コード
'BaseCollectionはgetFilelistRecursively内で書き換わるので注意 '返り値とBaseCollectionは、全く同じColelctionを指すので、どちらを使ってもOK Function getFilelistRecursively(Path As String, _ Optional ByRef BaseCollection As Collection _ ) As Collection If BaseCollection Is Nothing Then Set BaseCollection = New Collection End If 'Pathで指定されたフォルダ配下のフォルダを取得 'フォルダがあれば再帰処理 Dim Folders As Collection Set Folders = DirWrapper(Path, "*", vbDirectory) Dim Folder As Variant If Not Folders Is Nothing Then For Each Folder In Folders Call getFilelistRecursively(CStr(Folder), BaseCollection) Next End If 'Pathで指定されたフォルダ配下のファイルを取得 Call DirWrapper(Path, "*.*", vbNormal, BaseCollection) Set getFilelistRecursively = BaseCollection End Function 'BaseCollectionはDirWrapper内で書き換わるので注意 '返り値とBaseCollectionは、全く同じColelctionを指すので、どちらを使ってもOK Function DirWrapper(Path As String, _ Filter As String, _ Optional Attributes As VbFileAttribute = vbNormal, _ Optional ByRef BaseCollection As Collection _ ) As Collection If BaseCollection Is Nothing Then Set BaseCollection = New Collection End If Dim Filename As String Dim FileAtt As VbFileAttribute On Error GoTo ErrorDebugPrint Filename = Dir(Path & "\" & Filter, Attributes) On Error GoTo 0 Do While Filename <> "" 'GetAttr(Filename)とAttributesの間のandは、ビット演算のAndであることに注意 FileAtt = -1 On Error GoTo ErrorDebugPrint FileAtt = GetAttr(Path & "\" & Filename) On Error GoTo 0 If FileAtt >= 0 Then If Attributes = vbNormal Or (FileAtt And Attributes) Then If Filename <> "." And Filename <> ".." Then BaseCollection.Add Path & "\" & Filename End If End If End If Filename = Dir() Loop Set DirWrapper = BaseCollection Exit Function ErrorDebugPrint: Debug.Print Err.Number & " : " & Path & Filename Resume Next End Function 'テストコード Sub test_getFilelistRecursively() Dim t As Double t = Time Dim V As Variant Set V = getFilelistRecursively("Z:\") Debug.Print Time - t End Sub
実行結果
公開されているそのままのコードでは、最後まで実行することができませんでした。
とりあえず最後までたどり着いてくれないと計測できないので、何箇所か手を加えてエラー発生時はイミディエイトウィンドウにパスを書き出した後、無視して続行するようにしました。
本来であれば「On Error GoTo ～」の2箇所は書きたくありません。
ちなみにエラーの情報を下記に残しておきます。
エラーメッセージ
実行時エラー52 ファイル名または番号が不正です。
エラー箇所
Filename = Dir(Path & "\" & Filter, Attributes)
または
If Attributes = vbNormal Or (GetAttr(Path & "\" & Filename) And Attributes) Then
エラーとなったパス
Z:\Anime\TV\[200910]-[200912]\11eyes -罪と罰と贖いの少女-\11eyes 第01話 「赤い夜 ?Piros ejszaka」.mp4
本当は次のようなパスが正しいものでした。
Z:\Anime\TV\[200910]-[200912]\11eyes -罪と罰と贖いの少女-\11eyes 第01話 「赤い夜 〜Piros éjszaka」.mp4
エラーの原因
どうやらWikipediaからコピーしてきた「〜」がShift-JISで表現できない文字だったようです。
ただし「Shift-JISで表現できない文字」とか「Unicodeでないと使えない文字」なんて呼び名は長いので本記事では雲丹文字って呼びますね。
ちなみに私は雲丹は苦手です。もし自慢の雲丹があったらお会いしたときに最高に美味しい雲丹を食べさせてください。そしたら気が変わるかもしれません。
ちなみに普通にキーボードから入力できる「～」は雲丹文字じゃないのでご安心ください。
そもそも、上記パスの「～」は消し忘れなのでは？ って言う疑問は置いといて。
原因について簡単に説明すると、（私もふわっとしか理解してないのですが）現代のWindowsのNTFSではUTF-8でファイル名を管理しており、旧時代から続くコマンドプロンプトやVBAの標準ステートメントはShift-JISに自動的に変換して処理をするみたいです。
VBAでパスを取得したときにShift-JISに変換できない文字が現れると、変数には「?」が含まれたパスが格納されるため、後の処理で不正なパスを渡してエラーが起こります。
つまりDirでは
雲丹文字が紛れ込んだ時点では実行時エラーが起こりません！！！
実行時エラーが出たときにはすでに手遅れです。恐ろしい話ですね。
※ついでに言えば、Dirで存在確認コードを実行すると直前のDirと干渉しますし、fso.FileExistsを使うなら初めからfso使えば良いし、速度に大幅な影響が・・・っていうジレンマに陥りそうです。
美味い方法 じゃなくて上手い方法をご存知の方は、あとでこそっと教えてください。
ちなみに先の記事で書かれていたようなワンステップでファイルリストを作成するコードの場合もVBAのDirと同様に雲丹文字は「?」に化けてしまいました。
FileSystemObjectを使った関数
さて、お次は大正義FileSystemObjectを使った関数です。
Twitterでも「FileSystemObject」を使うべきだという意見が大多数でしたね。
概要
今回は昔から私が愛用している、ちょい癖のあるコードを紹介します。
どんな癖があるかというと次の点でしょうか。
- 戻り値はparentFolderに対する相対パスである。
- ファイルのみ、フォルダのみ、ファイルとフォルダの3パターンが選択できる。
- 探索する階層数を指定できる。全て探索する場合は-1の指定が必要。
- フォルダの末尾は必ず\とする。←私の好み
絶対パスにするとparentFolder部分の重複文字列が大量に記憶されるのでメモリの無駄遣いだとか、ファイルの一括操作を行うときには相対パス部分しか使わないからparentFolderのパスは不要だろう。
という、実用的な考えに基づいて設計したつもりです。
一応コードを公開するために、少し見直したのでバグが出ているかもしれません。ミスに気がついたら教えてください^^;
コード
'******************************************************************************* '指定フォルダ以下の指定階層までのファイル・フォルダをリストアップする関数 '******************************************************************************* 'parentFolder : 検索対象フォルダを示すFolderオブジェクト 'AddFile : ファイルを対象に含めるか 'AddFolder : フォルダを対象に含めるか 'SubMax : 何階層探索するか（0～n、-1の時は無制限） 'Path : 再帰用 : ルートフォルダ以降のパス 'SubCount : 再帰用 : 現在何階層目か 'PathList : 再帰用 : パスリスト。最終的な戻り値 Public Function GetFileFolderList(ByVal parentFolder As Folder, _ Optional ByVal AddFile = False, _ Optional ByVal AddFolder = False, _ Optional ByVal SubMax As Long = 0, _ Optional ByVal Path As String = "", _ Optional ByVal SubCount As Long = 0, _ Optional ByRef PathList As Collection _ ) As Collection If PathList Is Nothing Then Set PathList = New Collection End If ' ■サブフォルダ Dim objPath As Folder For Each objPath In parentFolder.SubFolders If AddFolder Then PathList.Add Path & objPath.Name & "\" ' フォルダの末尾は "\" End If If SubCount < SubMax Or SubMax = -1 Then Call GetFileFolderList(objPath, AddFile, AddFolder, SubMax, _ Path & objPath.Name & "\", SubCount + 1, PathList) End If Next ' ■ファイル Dim objFile As File If AddFile Then For Each objFile In parentFolder.Files PathList.Add Path & objFile.Name Next End If Set GetFileFolderList = PathList End Function 'テストコード Sub GetFileFolderListTest() Dim t As Double t = Time Dim v As Variant Dim f As Folder Dim fso As FileSystemObject: Set fso = New FileSystemObject Set f = fso.GetFolder("Z:") Set v = GetFileFolderList(f, True, False, -1) Debug.Print Time - t End Sub
フリーソフトを使った関数
概要
公開したかったんですが、大人の事情によりお見せできません。←察して／／／
簡単に説明すると、
という感じの流れです。
もちろん所定のパスにフリーソフトが無いと動かない危険なコードなので、多くの方からは嫌がられることでしょう。
比較表
それでは結果発表です！
| 取得方法 | 時間 | 秒数 | 倍率 | 特徴 |
|---|---|---|---|---|
| FileSystemObject | 00:17:48 | 1,068 | 18.41 | 遅い |
| Dir | 00:03:40 | 220 | 3.79 | 雲丹文字非対応 |
| フリーソフト | 00:00:58 | 58 | 1.00 | 外部実行ファイル必須 |
私の予想の「fsoはフリーソフトより100倍遅い」というのは、ちょっと大げさだったようです。
でも考えてみてください。
1分待て！と言われたら待てますが、17分待て！と言われたら待てませんよね？
17分もあったら表のコンビニまで夕食を買い物に行くくらいは余裕です。
夕食も食わずに残業している人たちにとっては、堂々と休める貴重な休憩時間なのかもしれませんが。
待ち時間4秒なら実際には「一瞬で終わった」という感想を持ちますが、Excelが応答不可になって20秒も待たされたあたりで「Excelフリーズしたかも？いつ終わるのかな？一度強制終了して暇な時に動かそうかな？」って不安になりませんか？
17倍というのは、そのくらいの差があるのです。
Dirに関しては1068秒→220秒で4.85倍高速なようです。
環境が違えば多少は変わるかもしれませんが、極端には改善されないでしょう。
補足
Dirに関して
Dirについては調査の過程で気になる記事も見かけたので貼っておきます。
'最後のフォルダが読み取り専用フォルダの場合は、\をつけないとエラーがおきます。 buf = Dir(Path_Str, vbDirectory + vbHidden) '←読み取り専用追加 vbHiddenを追加したらうまく行きました。
VBAの中断について
ファイルリストの作成中に中断したくなる場面があるかもしれません。
安全にVBAを中断させたいときは、私の考えた
のテクニックを使うと幸せになるかも。
尚、DoEventsを入れることでエクセルの応答無しを防ぐことはできますが、速度は落ちるし意図せぬイベントの割り込みが発生するので、呼び出し頻度にはご注意下さい。
まとめ
当初の「Dirを使ってファイルリストの作成を高速化しよう」という計画は、早々に断念することになりました。
グローバル化の進んだ現代でもファイルパスにUnicode文字が含まれていることはあまり多くないと思いますが、「全く無いわけではない」という事を考えるとシステムとしては許容できないレベルの不具合だと思います。
従って私の中では「DirやGetAttrは使用禁止」という結論に至りました。 ←仕事が増えた(・8・)
またfsoが遅いのはこれで証明されましたが、結局のところ正攻法ではfso以外の選択肢は無いということも分かりました。
遅いのは我慢して皆もガンガンfsoを使っていきましょう♪
それでも速度を優先したいぜっ！って人は試行錯誤して頑張ってください。
続編
続きを書きました。もしよろしければこちらも御覧ください。
以上
何か御座いましたらコメント欄、またはTwitterからどうぞ♪
それではまた来週♪ ちゅんちゅん(・8・)
