えくせるちゅんちゅん

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

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

今回は巷で話題になっていたVBAのファイルリスト作成について、既存の関数の高速化を目指して私の調査した結果を報告します。

※最終版のプログラムは下記の記事にて記載していますので、ソースコードだけをお求めの方はコチラを御覧ください。

www.excel-chunchun.com


初めに

Dirはfsoより高速…?

先日、私のいつも読ませて頂いているinformentさんが掲載した下記の記事に、このような記述がありました。

Dir関数が高速でお手軽である一方、FileSystemObjectは遅いが高機能、ということらしい。個人的には、FileSystemObjectの方が好みだ。

infoment.hatenablog.com

もちろん私も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を使った方法

概要

なんと、ちょっと「あるといいな♪」と呟いただけなのですが、いつもお世話になっている はけた氏 がコードを書いてくれました。

せっかくなので、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でないと使えない文字」なんて呼び名は長いので本記事では雲丹文字って呼びますね

ちなみに私は雲丹は苦手です。もし自慢の雲丹があったらお会いしたときに最高に美味しい雲丹を食べさせてください。そしたら気が変わるかもしれません。

ちなみに普通にキーボードから入力できる「~」は雲丹文字じゃないのでご安心ください。

そもそも、上記パスの「~」は消し忘れなのでは? って言う疑問は置いといて。

原因について簡単に説明すると、(私もふわっとしか理解してないのですが)現代のWindowsNTFSでは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やGetAttrは使用禁止」という結論に至りました。 ←仕事が増えた(・8・)

またfsoが遅いのはこれで証明されましたが、結局のところ正攻法ではfso以外の選択肢は無いということも分かりました。

遅いのは我慢して皆もガンガンfsoを使っていきましょう♪

それでも速度を優先したいぜっ!って人は試行錯誤して頑張ってください。

続編を書きましたので、こちらも合わせて御覧ください。

kotori-chunchun.hatenablog.com


おまけ1

Dirについては調査の過程で気になる記事も見かけたので貼っておきます。

教えてGoo - GetAttrが原因?

'最後のフォルダが読み取り専用フォルダの場合は、\をつけないとエラーがおきます。 buf = Dir(Path_Str, vbDirectory + vbHidden) '←読み取り専用追加 vbHiddenを追加したらうまく行きました。


おまけ2

ファイルリストの作成中に安全にVBAを中断させたいときは、私の考えた 秘技VBA強制終了の術 をお使いください。

DoEventsを入れることでエクセルの応答無しを防ぐことはできますが、速度は落ちるし意図せぬイベントの割り込みが発生するので、DoEventsを呼び出す必要はないと私は思います。

以上


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

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

それでは、また今度♪ ちゅんちゅん(・8・)