【ExcelVBA】FileSystemObjectを使ってファイル一覧を取得するには

Yahoo!知恵袋にあった質問から、FileSystemObjectを使ってファイル一覧を取得するVBAを紹介します。

質問

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12271386442

Microsoft Scripting Runtimeのライブラリを利用してExcelのファイルがあるフォ ルダに存在するファイルの一覧をシートに書き出すプログラムを作りたいです。

•書き出す内容は，ファイル名，種類，サイズを1行に1ファイル

• 表示に関してはActiveCellのOffsetで位置制御を行い出力

• 繰り返しはFilesのコレクション形状のデータを利用し，「For Each 変数 In コレクション」で繰り返し処理を行う

よくわからないので教えていただけると嬉しいです。

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12271386442

回答

質問文にある、「Excelのファイルがあるフォルダ」というのがマクロブックの存在するフォルダという解釈でよいのなら、こんな感じになります。↓

Option Explicit

Public Sub GetFilesList()
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim stCurrent As String
    stCurrent = ThisWorkbook.Path   'Excelのファイルがあるフォルダのパスを取得

    Dim File As Object
    Dim Var(1 To 3) As Variant  '吐き出す用の配列。3セル分必要なので1から3までとした。
    Dim ii As Long
    ii = 0
    For Each File In FSO.GetFolder(stCurrent).Files
        
        Var(1) = File.Name
        Var(2) = File.Type
        Var(3) = File.Size
        
        ActiveCell.Offset(ii, 0).Resize(1, 3).Value = Var   'ActiveCellがどこか保証がない
        ii = ii + 1
    Next File
        
    Set FSO = Nothing
    
End Sub

解説

このコードだと、ヘッダがないので、シートに書き出したときにどの列がどの値か分からない不親切設計となっています。

ActiveCellが現在どこにあるか把握せずに書き出しているので、元の値があったら上書きされてしまいますし、レコード数とActiveCellの現在位置の関係でエラーになることも考えられます。

そのあたりは質問者さんがエラー制御すればよいと思って、最小限のコードだけにしています。

別解

質問者さんがActiveCellとOffsetを使いたいというご要望があったのでこうしたのですが、普段の私だったら、1行1行書き込むのは処理速度が遅くなって嫌なので、次のように書くことが多いです。

Public Sub GetFilesList2()
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim stCurrent As String
    stCurrent = ThisWorkbook.Path   'Excelのファイルがあるフォルダのパスを取得

    Dim File As Object
    Dim Var() As Variant '吐き出す用の配列。・・・・①
    Dim ii As Long
    ii = 0
    ReDim Preserve Var(1 To 3, 0 To ii) '・・・②
    For Each File In FSO.GetFolder(stCurrent).Files
        
        Var(1, ii) = File.Name  '・・・③
        Var(2, ii) = File.Type  '・・・③
        Var(3, ii) = File.Size  '・・・③
        
        ii = ii + 1
        ReDim Preserve Var(1 To 3, 0 To ii) '・・・④
    Next File
        
    Dim lRow As Long    '行数(レコード数)を把握するための変数(Var配列の場合、第2要素)
    lRow = UBound(Var, 2)   '行数(レコード数)把握
    ActiveCell.Resize(lRow, 3).Value = WorksheetFunction.Transpose(Var)   '・・・⑤
    Set FSO = Nothing
    
End Sub

元のコードと異なる個所に①～⑤の番号をふりました。

①Var()配列を空っぽで定義

こうしておき、処理の中で動的に配列を増やしています。

②Var()配列を再定義

再定義するときの注意で、Excelの場合、第1要素は拡大できません。

拡大できるのは第2要素(というか、一番最後の要素)だけです。

今回行数をどんどん拡大していきたいのですが、Excelの仕様上、それはできませんから、あきらめて列方向に増やしていくことにします。

再定義するときにPreserveをつけて、元の値を維持します。

③値を書き入れる

Var()配列は行と列が逆になっていますので、添え字に注意して値を書き入れます。

④またVar()配列を再定義し、列方向に拡大する

Preserveをつけて、元の値を維持します。

⑤セルに書き出すときは、一度に書き出す

セルに書き込むのはどうしても物理的なアクセスが発生するらしく、処理が遅くなります。

書き出すタイミングを、値を把握した都度やるのではなく、最後にまとめて1回だけでやります。

こうすることで、なるべく処理を早くしています。

なお、Var()配列は行と列の関係が普通のシートと逆になっていますので、WorksheetFunctionの行と列を入れ替えてくれる関数、Transposeをかませています。

まとめ

以上、FSOを使ってファイル一覧を取得するVBAをご紹介しました。

私はExcelについては多少分かるので、ブログの記事ネタを提供してくれるなら、今なら無料でExcel相談を受け付けています。

匿名でできますので、ご利用ください(ただし、すぐに回答があるとは限らないし、全部の質問に答えられるとも限りません。あと個人情報や機密情報が含まれるExcelブックは送らないでください)。

Excel相談

https://kn-sharoushi.com/excel_consultation/