えくせるちゅんちゅん

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

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

今回は先日書いた「VBAでファイルリストを高速に取得する関数を自作する」の続編です。

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

www.excel-chunchun.com


前回の記事では

kotori-chunchun.hatenablog.com

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

  • dirは雲丹文字が読み込めない為、実用には向いていない
  • dirはfsoより数倍高速
  • フリーソフトはdirより数倍高速

つまりdirより高速に取得することは技術的には可能なはず。コマンドプロンプトとか…。

そう思ってたら見事に指摘されちゃいました。(ノω・)テヘ

https://twitter.com/excelspeedup/status/1080768445677883392

ちなみにコマンドプロンプトを使う方法については、さり気なく

ちなみに先の記事で書かれていたようなワンステップでファイルリストを作成するコードの場合もVBAのDirと同様に雲丹文字は「?」に化けてしまいました。

と書いておいたのですが、化けずに取り出す方法が分からないため、このまま迷宮入りにするつもりでした。

ところが、なんと@furyutei様から化けないコードを紹介して頂きましたので、360°方向転換して前回同様に比較したいと思います。(※360°は誤字ではないですからね?)


コマンドプロンプトを使ったファイルリストの作成

それでは早速コードです。

コード

尚、コードはGitHubにて公開されておりますので、こちらを使わせていただきました。

※1 コマンドプロンプトをユーザーが閉じたら途中で中断が出来るようにしています。

※2 恐れながらAPI削減の為、SafeArrayAllocDescriptorをSplit(vbNullString)に置き換えました。

Const WshHide = 0               '非表示
Const WshNormalFocus = 1        '通常サイズ

Function TrimEx(TargetString As String, Optional TrimLeft As Boolean = True, Optional TrimRight As Boolean = True) As String
    Dim reg_pattern As String

    If TrimLeft And TrimRight Then
        reg_pattern = "(?:^\s+|\s+$)"
    ElseIf TrimLeft Then
        reg_pattern = "^\s+"
    ElseIf TrimRight Then
        reg_pattern = "\s+$"
    Else
        TrimEx = TargetString
        Exit Function
    End If

    With CreateObject("VBScript.RegExp")
        .Pattern = reg_pattern
        .IgnoreCase = False
        .Global = True
        TrimEx = .Replace(TargetString, "")
    End With
End Function

Function GetFileListTmpfile(FolderLocation As String, Optional ShowCmdWindow As Boolean = True) As String()
    GetFileListTmpfile = Split(vbNullString)

    Dim tmpfile As String
    Dim filelist() As String

    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(FolderLocation) Then
            Debug.Print "* Error * Folder(" & FolderLocation & ") not found"
            Exit Function
        End If
        Do
            tmpfile = .GetSpecialFolder(2) & "\" & .GetTempName
        Loop While .FileExists(tmpfile)
    End With

    CreateObject("Wscript.Shell").Run "cmd /U /C dir /S /B /A-D """ & FolderLocation & """ > " & tmpfile, _
                                        IIf(ShowCmdWindow, WshNormalFocus, WshHide), True

    'コマンドプロンプト表示がONで強制終了(中断)された時の対策
    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(tmpfile) Then
            Exit Function
        End If
    End With

    With CreateObject("ADODB.Stream")
        .Charset = "Unicode"
        .Open
        .LoadFromFile tmpfile
        filelist = Split(TrimEx(.ReadText), vbCrLf)
        .Close
    End With

    Kill tmpfile

    GetFileListTmpfile = filelist
End Function

Sub test_GetFileListTmpfile()
    Dim t As Double
    t = Time
    Dim V As Variant
    'エクセルが応答不能になる。使用する場合は超注意
    'Application.Interactive = False    
    V = GetFileListTmpfile("Z:\", True)
    'Application.Interactive = True
    Debug.Print Time - t
End Sub

解説

解説と言っても、大した事は説明できないのですが

  • 一時ファイルのパスを取得
  • コマンドプロンプトを起動して「dir パス /S /B /A-D」を実行して結果を一時ファイルへ書き出し
  • 一時ファイルをADODB.StreamでUnicodeで読み取り
  • vbCrLFで改行を分解して文字列配列で返却

という感じの流れのようです。

私の好みだと思いますが、ファイルリストを作成している間エクセルが操作可能状態になってしまうためメリット/デメリットを考慮した結果、コマンドプロンプトはあえて表示したままを選択できるようにしました。

エクセルが操作できないようにするために「Application.Interactive」のスイッチを切っても良いのですが、何らかのトラブルでVBAが中断されると大変なことになるので、使用を控えたいところです。

コマンドプロンプトの表示/非表示は、CreateObject("Wscript.Shell").Runの第二パラメータに「WshWindowStyle」配下の定数を使うようです。

あまり検索でヒットしないので正式名ではないのかもしれませんが、0とか1のマジックナンバーは苦手なので、本物かどうかは抜きにしてとりあえず使っていきます。

WSH/外部コマンドを実行する方法・Runメソッド

結果

前回と同じ条件で計測した結果になります。

倍率については最速であるフリーソフトの計測結果を1として評価したものです。

取得方法 時間 秒数 倍率 特徴
FileSystemObject 00:17:48 1,068 18.41 遅い
Dir 00:03:40 220 3.79 雲丹文字非対応
コマンドプロンプト 00:02:09 129 2.22 コマンドプロンプト実行必須
フリーソフト 00:00:58 58 1.00 外部実行ファイル必須

コマンドプロンプト法の特徴としてはこんなところでしょうか。

  • 文句なしの処理速度
  • 文字化けはし無い
  • 処理している間エクセルが操作できる
  • コマンドプロンプトを表示しておけば)ユーザーが途中で安全に中断できる
  • セキュリティ設定次第でコマンドプロンプトが実行できない環境がある(かも)

最後の件は、下記のサイトにてソレらしい発言があった為、警告としてメモしておきます。

https://stackoverrun.com/ja/q/7205728

クリップボードを経由する方法

GitHubで公開されているコードでは一時ファイルの他にクリップボードを経由する方法も記載されており、こんな感じにすると結果がクリップボードに格納されるようです。

CreateObject("Wscript.Shell").Run "cmd /C chcp 65001 & cmd /C dir /S /B /A-D """ & FolderLocation & """ | clip", 0, True

Wscript.Shellは詳しくないので大変勉強になりました。

クリップボードの内容を取り出すときはDataObjectを使うのが一般的ですが、エラーが出るようなのでテキストボックスに貼り付けて、その結果を読み取ることで取り出していました。

安定動作を目指してかなり苦労されたものと思います。

私もフリーソフトからファイルリストを取得するときにクリップボードを経由していますが、この方法は他のプロセスの影響を受けやすいため一時ファイルを使えるならそちらを使うに越したことはないと思います。


別のサーバーでの計測結果

概要

奇跡的にも別のサーバーにて検証する機会することが出来たので結果を報告します。

詳しくは聞いちゃダメなんだからね!

項目 スペック
OS 秘密(Unix系の何か)
ストレージ RAID10
SMB Version SMB2.1
シーケンシャルリード実測値 113MB/s
対象容量 2TB
ファイル数 1,794,300
フォルダ数 73,332

SMB2.1の結果

結果としてはこんな感じになりました。

注目はやはり、コマンドプロンプトの速さでしょう。

取得方法 時間 秒数 倍率
FileSystemObject 0:18:25 1105 11.16
dir 0:08:31 511 5.16
コマンドプロンプト 0:01:52 112 1.13
フリーソフト 0:01:39 99 1.00

一応、2種類の環境における比較表も貼っておきます。

取得方法 自宅SV倍率 ○○SV倍率
FileSystemObject 18.4 11.2
dir 3.8 5.2
コマンドプロンプト 2.2 1.1
フリーソフト 1.0 1.0

見ての通りfsoとコマンドプロンプトは倍近く早くなっていますが、dirは逆に遅くなっています。

つまり環境次第で結構な差がつきそうだと予想されます。

SMB3.1.1の結果

ついでにサーバーの設定をSMB3.1.1対応をONにして試してみた。

結論から言えば、SMB2.1と同じと言っても差し支えない範囲の誤差でした。

ただしSMB3.1.1は本サーバー非推奨らしいので、見た目は3.1.1に変わっていましたWindows Serverでも全く変わらないのかどうかは信用しないほうが良いと思われます。

取得方法 時間 秒数 倍率
FileSystemObject 1:14:16 4456 11.37
dir 0:34:12 2052 5.23
コマンドプロンプト 0:07:32 452 1.15
フリーソフト 0:06:32 392 1.00

補足:クラサバ間のSMBバージョンはPowerShellを管理者として実行して、Get-SmbConnectionで確認できるが、何故かその後Explorerがクラッシュする現象を複数のPCで確認したので、コマンドを叩くときは注意するように。


参考

fsoについてはthomさんが私の言いたいことを上手くまとめて下さったので、読んでない方は是非読んでみてください!

thom.hateblo.jp

コマンドプロンプトやパワーシェルの呼び出しを隔離するモジュールを、これまたthomさんが書かれていたので参考になりそうでした!

thom.hateblo.jp


まとめ

今回はコマンドプロンプトを使ったファイルリストの作成方法について説明しました。

当初イメージしていたような「VBA(のみ)でファイルリストを(fsoより)高速に取得する関数」は実現できませんでしたが、従来の「フリーソフトを使った方法」よりは汎用性の高い関数が出来ました。

心配なのは

が実在するのかどうか・・・ですが、そもそもコレほど大量のファイルリストをEXCELで作りたがるのは私だけだと思うので、その辺は上手いこと使っていきたいと思います。

以上


続編

ついに夢の高速・安定を兼ね備えたファイルリスト作成関数が完成!!!

www.excel-chunchun.com


参考

VBA - 【VBA】サブディレクトリも含めたファイル一覧を素早く取得したい|teratail



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

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

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