トップ > 備忘録 > 再帰呼び出しを使用したファイルのリストアップ

ファイルのリストアップ再帰呼び出しを使用したファイルのリストアップ 2013.06.18   更新:2023.11.22

プログラムのある関数が、自分自身の関数を呼び出す「再帰」。その再帰呼び出しを利用して、任意のフォルダのサブフォルダ、ファイルをリストアップするコードとメモです。

ポイント

・FileDiarogプロパティ
・フォルダの存在確認
・再帰呼び出し
・FileSystemObject

FileDialogプロパティの引数に「msoFileDialogFolderPicker」を設定しコードを実行すると、「参照」のダイアログが表示される。ダイアログではフォルダを選択でき、選択したフォルダは、SelectedItemsプロパティで、そのパスを取得できる。

何らかの理由で、フォルダの存在を確認するケースも考えられるので、Dir関数を用いたフォルダの存在確認方法を、補足として併記する。

再帰呼び出しは、ある計算結果に対して同じ処理を連続して行う場合に使うことが多い。コードが簡素化される利点もあるが、処理から抜ける条件が成り立たず、無限ループに陥ることがあるため、気をつけなければならない。
今回、再帰呼び出しのサンプルとしてファイルをリストアップする。尚、処理を抜ける条件は「任意のフォルダにサブフォルダが存在しない」である。

再帰呼び出し中での、フォルダ、ファイルの操作にはFileSystemObjectを使用した。

このコードを利用したソフトはこちら「ファイルリストアップ
処理の中断、重複ファイルの確認等の処理を追加している。


【お薦め】マクロ・プロシージャを管理する無料のツール!
 Excelマクロ管理ツール

サンプルコード

再帰呼び出しを利用したファイルのリストアップ。リストアップしたデータは新規ブックに書き込まれる。

'-----------------------------------------------------------------------
' 指定したフォルダ配下のサブフォルダとファイルをリストアップするマクロ
'-----------------------------------------------------------------------
'[作成日]2013.06.18 [更新日]2023.11.22
' https://excel.syogyoumujou.com/memorandum/file_listup.html
'-----------------------------------------------------------------------
Sub MacroToListFoldersAndFiles()
    '-----------------------------------------------------------
    ' フォルダ選択
    '-----------------------------------------------------------
    Dim strFolderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            strFolderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    If Dir(strFolderPath, vbDirectory) = "" Then GoTo ERROR1

    '-----------------------------------------------------------
    ' 選択フォルダ配下のサブフォルダ数とファイル数をカウントする(再帰関数)
    '-----------------------------------------------------------
    Dim lngFoldersCount    As Long 'フォルダ数格納用
    Dim lngFilesCount      As Long 'ファイル数格納用
    Dim lngFolderHierarchy As Long 'フォルダ階層格納用
    Dim lngMaxHierarchy    As Long '最大階層数
    
    If Not CountTheNumberOfFoldersAndFiles(strFolderPath, _
                                           lngFoldersCount, _
                                           lngFilesCount, _
                                           lngFolderHierarchy, _
                                           lngMaxHierarchy) Then GoTo ERROR2
                                           
    '-----------------------------------------------------------
    ' 配列を作成
    '-----------------------------------------------------------
    ReDim varDataArea(1 To lngFoldersCount + lngFilesCount, 1 To lngMaxHierarchy + 1) As Variant

    '-----------------------------------------------------------
    ' 選択フォルダのサブフォルダとファイルを配列にリストアップ(再帰関数)
    '-----------------------------------------------------------
    If Not ListSubfoldersAndFilesInArray2d(varDataArea, 1, 1, strFolderPath) Then GoTo ERROR2

    '-----------------------------------------------------------
    ' 新規ブックに出力
    '-----------------------------------------------------------
    With Workbooks.Add.Worksheets(1)
        .Cells(1, 1).Value = "[" & strFolderPath & "]"
        .Cells(2, 2).Resize(UBound(varDataArea, 1), UBound(varDataArea, 2)).Value = varDataArea
    End With
    
    MsgBox "フォルダ数:" & lngFoldersCount & vbLf & _
           "ファイル数:" & lngFilesCount, _
           vbInformation, "処理完了"
    Exit Sub
ERROR1:
    MsgBox "選択したフォルダは対象外です", vbOKOnly + vbExclamation, "中止します"
    Exit Sub
ERROR2:
    MsgBox "予期せぬエラーが発生しました", vbOKOnly + vbExclamation, "中止します"
End Sub

'----------------------------------------------------------------------- ' 指定フォルダ配下のフォルダとファイルの数を数えるプロシージャ(再帰型) '----------------------------------------------------------------------- '[引数] ' FolderPath :対象フォルダパス ' FolderCount :サブフォルダ数 ' FileCount :ファイル数 ' FolderHierarchy:フォルダ階層 ' MaxHierarchy :最大階層数 '[戻り値] ' True :成功 ' False :失敗 '[作成日]2013.06.18 [更新日]2023.11.22 ' https://excel.syogyoumujou.com/memorandum/file_listup.html '----------------------------------------------------------------------- Function CountTheNumberOfFoldersAndFiles(ByVal FolderPath As String, _ ByRef FoldersCount As Long, _ ByRef FilesCount As Long, _ ByRef FolderHierarchy As Long, _ ByRef MaxHierarchy As Long) As Boolean On Error GoTo ERROR_HANDLER Dim F As Object Dim strSubFolderPath As String With CreateObject("Scripting.FileSystemObject").GetFolder(FolderPath) FoldersCount = FoldersCount + .SubFolders.Count 'フォルダ数取得 For Each F In .SubFolders FolderHierarchy = FolderHierarchy + 1 If MaxHierarchy < FolderHierarchy Then MaxHierarchy = FolderHierarchy strSubFolderPath = FolderPath & Application.PathSeparator & F.Name '再帰 If Not CountTheNumberOfFoldersAndFiles(strSubFolderPath, _ FoldersCount, _ FilesCount, _ FolderHierarchy, _ MaxHierarchy) Then GoTo ERROR_HANDLER FolderHierarchy = FolderHierarchy - 1 Next FilesCount = FilesCount + .Files.Count 'ファイル数取得 End With CountTheNumberOfFoldersAndFiles = True ERROR_HANDLER: On Error GoTo 0 End Function
'----------------------------------------------------------------------- ' サブフォルダ・ファイルを2次元配列にリストアップ(再帰型) '----------------------------------------------------------------------- '[引数] ' DataArea :データ書き込み用配列 ' RowCount :書き込み行数 ' ColumnCount:書き込み列数 ' FolderPath :対象フォルダパス '[戻り値] ' True :成功 ' False :失敗 '[作成日]2013.06.18 [更新日]2023.11.22 ' https://excel.syogyoumujou.com/memorandum/file_listup.html '----------------------------------------------------------------------- Function ListSubfoldersAndFilesInArray2d(ByRef DataArea As Variant, _ ByRef RowCount As Long, _ ByRef ColumnCount As Long, _ ByVal FolderPath As String) As Boolean On Error GoTo ERROR_HANDLER Dim F As Object Dim strSubFolderPath As String With CreateObject("Scripting.FileSystemObject").GetFolder(FolderPath) 'サブフォルダ検索 For Each F In .SubFolders 'フォルダ名をセルに書き込み DataArea(RowCount, ColumnCount) = "[" & F.Name & "]" RowCount = RowCount + 1 ColumnCount = ColumnCount + 1 'サブフォルダパス作成 strSubFolderPath = FolderPath & Application.PathSeparator & F.Name '再帰 If Not ListSubfoldersAndFilesInArray2d(DataArea, _ RowCount, _ ColumnCount, _ strSubFolderPath) Then GoTo ERROR_HANDLER ColumnCount = ColumnCount - 1 Next 'ファイル検索 For Each F In .Files 'ファイル名をセルに書き込み DataArea(RowCount, ColumnCount) = F.Name RowCount = RowCount + 1 Next End With ListSubfoldersAndFilesInArray2d = True ERROR_HANDLER: On Error GoTo 0 End Function

※サンプルコードがエラーで中断される場合
・VBEのオプション設定を変更 参照
・プロジェクトをロックする 参照

メモ

「$」の付く関数

 参照

Join関数

 参照

InstrRev関数

 参照

FileDiarogプロパティ

ファイルダイアログを表示する。引数により表示されるダイアログの種類が異なる。引数に設定できるのは、次のMsoFileDialogTypeクラスの定数のいずれか。

・msoFileDialogFilePicker 「参照」ダイアログでファイルを選択できます。
・msoFileDialogFolderPicker 「参照」ダイアログでフォルダを選択できます。
・msoFileDialogOpen 「ファイルを開く」ダイアログ
・msoFileDialogSaveAs 「名前をつけて保存」ダイアログ

ファイルダイアログは、ファイル(フォルダ)のパスを取得するものであり、「ファイルを開く」や「名前をつけて保存」のダイアログであっても、実際にファイルが開かれたり、保存されるものではない。

ダイアログで選択したファイル(フォルダ)パスの取得には、SelectedItemsプロパティを使用する。使用例は以下を参照。

Sub UseFileDialogOpen()
    Dim lngCount As Long
    ' ファイル ダイアログを開きます。
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True 'ファイルの複数選択を可能にする
        .Show
        ' 選択された各ファイルのパスを表示します。
        For lngCount = 1 To .SelectedItems.Count
            MsgBox .SelectedItems(lngCount)
        Next
    End With
End Sub

Dir関数

指定したパターンやファイル属性に一致する、ファイルやフォルダの名前の文字列を返す。返される文字列は(String型)。ドライブのボリュームラベルも取得可能。

構文:Dir[(pathname[, attributes])]

[pathname]
ファイル名を表す文字列式を指定。フォルダ名やドライブ名も含めて指定可能。
指定した内容が見つからないときは、長さ「0」の文字列を返す。

[attributes]
省略可能です。取得したいファイルの属性の値の合計、または定数を指定。
省略すると、標準ファイルの属性。Windowsでの「設定値」は以下の6つ
 【定数 / 値 / 内容】
vbNormal / 0 / 標準ファイル
vbReadOnly / 1 / 読み取り専用ファイル
vbHidden / 2 / 隠しファイル
vbSystem / 4 / システム ファイル
vbVolume / 8 / ボリューム ラベル。この値を指定すると、すべての属性は無効。
vbDirectory / 16 / フォルダ


ページトップへ戻る
Copyright(C) 2009- 坂江 保 All Rights Reserved.