【VBA】フォルダ配下のファイル／フォルダー一覧の取得

'ファイル取得
Public Function GetFiles(ByVal path, Optional is_sub_folder = False, Optional arr)
    
    'フォルダー配下検索の場合、新規で配列を用意する
    'サブフォルダー配下検索の場合、既存の配列に追加していく
    If (IsArray(arr) = False) Then
        Dim temp()
        arr = temp
    End If
    
    '対象のパスが\で終わっていなければ、\を追加
    If (Right(path, 1) <> "") Then
        path = path & "\"
    End If
    
    '配下のファイルでループ
    current_file = Dir(path)
    Do While (current_file <> "")
        
        'ファイルを配列に追加
        Call ArrayPush(arr, path & current_file)
        
        '次のファイルへ
        current_file = Dir()
        
    Loop
    
    'サブフォルダー配下も取得する場合、再起処理でサブフォルダー内のフォルダーも取得
    If (is_sub_folder) Then
        sub_folders = GetFolders(path)
        
        'サブフォルダーの数を取得
        sub_folders_count = -1
        On Error Resume Next
        sub_folders_count = UBound(sub_folders)
        
        'サブフォルダーでループ
        If (sub_folders_count > -1) Then
            For Each sub_folder In sub_folders
                Call GetFiles(sub_folder, True, arr)
            Next
        End If
    End If
    
    GetFiles = arr
    
End Function

'フォルダー取得
Public Function GetFolders(ByVal path, Optional is_sub_folder = False, Optional arr)

    'フォルダー配下検索の場合、新規で配列を用意する
    'サブフォルダー配下検索の場合、既存の配列に追加していく
    If (IsArray(arr) = False) Then
        Dim res()
        arr = res
    End If
    
    '対象のパスが\で終わっていなければ、\を追加
    If (Right(path, 1) <> "") Then
        path = path & "\"
    End If

    Set fso = New FileSystemObject
    Set sub_folders = fso.GetFolder(path)
    
    'サブフォルダーでループ
    For Each sub_folder In sub_folders.SubFolders
        
        'サブフォルダーのフォルダー名を取得
        sub_folder_name = Replace(sub_folder, path, "")
        
        '.で始まるフォルダーはシステム系の隠しフォルダーの場合が多く、取得したい場合がほぼないため除外
        If (Left(sub_folder_name, 1) <> ".") Then
            
            '配列に追加
            Call ArrayPush(arr, sub_folder)
            
            'サブフォルダー配下も取得する場合、再起処理でサブフォルダー内のフォルダーも取得
            If (is_sub_folder) Then
                Call GetFolders(sub_folder, True, arr)
            End If
        End If
    Next
    
    '後処理
    Set fso = Nothing
    
    GetFolders = arr

End Function

'配列の末尾に要素を追加
Public Function ArrayPush(arr, val)
    '更新する配列の長さを取得（デフォルト:0）
    arr_length = 0
    On Error Resume Next
    arr_length = UBound(arr) + 1
    
    '配列の長さ更新
    ReDim Preserve arr(arr_length)
    
    '末尾に要素を追加
    arr(arr_length) = val
End Function

Private Function test()
    
    'ファイル一覧取得
    res = GetFiles("C:\odaneko\vba")
    
End Function

Private Function test()

    'ファイル一覧取得（サブフォルダー配下も含む）
    res = GetFiles("C:\odaneko\vba", True)
    
End Function

Private Function test()
    
    'フォルダー一覧取得
    res = GetFolders("C:\odaneko\vba")
    
End Function

Private Function test()
    
    'フォルダー一覧取得（サブフォルダー配下も含む）
    folders_under_path_with_sub_folders = GetFolders("C:\odaneko\vba", True)
    
End Function