dirコマンド結果のテキストファイルからフォルダサイズを抜き出す

フォルダのサイズを調べるときに、コマンドプロンプトからdirコマンドを実行してサイズを調べます。/Sオプションをつけると、サブディレクトリのフォルダに対しても表示してくれます。しかし、例えば、Cドライブ配下のすべてのフォルダのサイズを取得していろいろ操作したい場合(大きいサイズ順位並べ替えたり、過去との比較をとったり)はExcelにデータを抜き出したほうがやりやすいかもしれません。「dir /S <指定ディレクトリ>」の結果からフォルダのサイズを抜き出すプログラムを作成してみました。
今回抜き出す部分は以下です。

これを複数取り出します。取り出す方法としては、テキスト全体を読み込んで、正規表現でパターンに一致する行を取得します。パターンに一致する行から不要な文字列を削除してセルに出力します。マッチさせる行は3パターンあります。処理の流れは、最初に1パターン目(フォルダ名)がマッチした時点でA8セルに出力します。次に、2パターン目(フォルダサイズ)がマッチした時点でB8セルに出力します。この時出力セルの行のカウンタをアップします。そのため、次に1パターン目にマッチしたときはA9セルに出力することとなります。これを続けていきます。3パターン目(ファイルの総数)はテキストファイルの最後から3行目のところに出力されている文字列です。ここから下の2行に総バイト数と空き容量が表示されています。この情報は今回は取得しないので、見つけた時点で検索を終了します。以下が実行結果画面とプログラムです。

Option Explicit

'#########################################
'参照設定：Microsoft Scripting Runtime
'          Microsoft VBScript Regular Expressions 5.5
'#########################################

Public Sub GetFolderSizeFromText()

    '前の情報を消去
    Range(Cells(8, "A"), Cells(10000, "B")).Clear

    'ファイルパスを取得
    Dim fPath As String
    fPath = Cells(4, "A").Value
    If Dir(fPath) = "" Or fPath = "" Then
        MsgBox "ファイルが存在しまんせん。"
        Exit Sub
    End If
    
    'ファイルオープン
    Dim objFS As FileSystemObject
    Dim objTS As TextStream
    Set objFS = CreateObject("Scripting.FileSystemObject")  'FileSystemObject生成
    Set objTS = objFS.OpenTextFile(fPath, ForReading)  'TextStreamオブジェクト生成
    Set objFS = Nothing 'FileSystemObjectは解放しておく
    
    '全量Bufferに読み込み
    Dim Buffer As String
    Buffer = objTS.ReadAll
    
    'ファイルクローズ
    objTS.Close
    Set objTS = Nothing 'TextStreamオブジェクト解放
    
    '検索パターン設定
    Dim objRE As RegExp
    Set objRE = CreateObject("VBScript.RegExp")    'RegExpオブジェクト生成
    objRE.Pattern = "^ .* のディレクトリ$|^.* バイト$|ファイルの総数"  'パターンの設定
    objRE.Global = True 'マッチしたものすべて取得
    objRE.MultiLine = True  '行単位で検索
    
    
    '検索結果の行数分ループ
    Dim objM As Match
    Dim y As Integer
    y = 8
    '*************************************************************************
    '* objRE.Execute(Buffer)の戻り値はMatchオブジェクトのコレクションです。  *
    '* Matchオブジェクトは検索結果が格納されています。                       *
    '*************************************************************************
    For Each objM In objRE.Execute(Buffer)
        '「ファイルの総数」だったらループを抜ける
        If InStr(objM.Value, "ファイルの総数") Then
            Exit For

        '「のディレクトリ」が含まれる行の場合
        ElseIf InStr(objM.Value, "のディレクトリ") Then
            '不要文字を切り取りセルに出力
            If Cells(y, 1) = "" Then
                Cells(y, 1).Value = Trim(Replace(objM.Value, "のディレクトリ", ""))
            Else
                MsgBox "エラーが発生したので終了します。"
                Set objRE = Nothing
                Exit Sub
            End If
            
        '「 バイト」が含まれる行の場合
        Else
            '不要文字を切り取りセルに出力
            If Cells(y, 2) = "" Then
                Cells(y, 2).Value = Trim(Replace(Right(objM.Value, 24), "バイト", ""))
            Else
                MsgBox "エラーが発生したので終了します。"
                Set objRE = Nothing
                Exit Sub
            End If
            y = y + 1   '次の行へ
        End If
        
    Next
    
    Set objRE = Nothing    'RegExpオブジェクト解放
    
    MsgBox "完了しました。"

End Sub