Option Explicit
Sub fileNameTable()
    
    '動作が速くなるおまじない開始
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .Cursor = xlWait
        .DisplayAlerts = False
    End With
    
'変数の宣言
    Dim wb As Workbook 'このファイル
    Dim wsSet As Worksheet '設定シート
    Dim wsTable As Worksheet '一覧シート
    Dim rowOutput As Long '出力行
    Dim fPass As String 'フォルダ、ファイルパス
    Dim fName As String 'ファイル、フォルダ名
    Dim ex() As String '拡張子
    Dim cntEx As Integer '拡張子の個数
    Dim i As Long 'カウンタ変数
    
'動作
    Set wb = ThisWorkbook
    With wb
        Set wsSet = .Sheets("設定")
        Set wsTable = .Sheets("一覧")
    End With
    
    'ファイル名一覧を出力する行番号を指定
    With wsSet
        fPass = .Range("C2").Value
        fName = fPass & "\"
        rowOutput = 2
        cntEx = 0
        For i = 3 To .Range("K3").End(xlToLeft).Column
            ReDim Preserve ex(cntEx)
            ex(cntEx) = .Cells(3, i).Value
            cntEx = cntEx + 1
        Next i
        cntEx = cntEx - 1
    End With
    
    Call fileNameOutput(wsTable, fPass, fName, ex(), cntEx, rowOutput)
    
    '一覧シートをアクティブにする
    wsTable.Activate
    
    '「完了」のメッセージボックスを表示する
    MsgBox "完了しました"
    
    '動作が速くなるおまじない終了
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .Cursor = xlDefault
        .DisplayAlerts = True
    End With
    
End Sub
Sub fileNameOutput(wsTable As Worksheet, fPass As String, fName As String, ex() As String, cntEx As Integer, rowOutput As Long)
    Dim objFSO As Object
    Dim objFiles As Object
    Dim objFile As Object
    Dim objSubFolders As Object
    Dim objSubFolder As Object
    Dim i As Long
    Dim col As Long
    '対象フォルダのパスの値があれば処理をおこないます。
    If fPass = "" Then
        MsgBox "対象フォルダのパスがありません。パスを入力してください。"
    Else
    
        'FileSystemObjectをインスタンスにセット
        Set objFSO = CreateObject("Scripting.FileSystemObject")
    
        '対象フォルダのファイルオブジェクトをセット
        Set objFiles = objFSO.GetFolder(fPass).Files
        
        'ファイル情報を出力
        With wsTable
            For Each objFile In objFiles
                For i = 0 To cntEx
                    If InStr(objFile.Name, ex(i)) > 0 Then
                        '通し番号
                        col = 1
                        .Cells(rowOutput, col).Value = rowOutput - 1
                        'ファイルパス
                        col = col + 1
                        .Cells(rowOutput, col).Value = objFile.Path
                        'フォルダパス
                        col = col + 1
                        .Cells(rowOutput, col).Value = Replace(objFile.Path, "\" & objFile.Name, "")
                        'ファイル名
                        col = col + 1
                        .Cells(rowOutput, col).Value = objFile.Name
                        '更新日
                        col = col + 1
                        .Cells(rowOutput, col) = Format(FileDateTime(objFile), "yyyy/m/d")
                        
                        rowOutput = rowOutput + 1
                    End If
                Next i
            Next objFile
        End With
    
        '対象フォルダのサブフォルダファイルオブジェクトをセット
        Set objSubFolders = objFSO.GetFolder(fPass).SubFolders
    
        'サブフォルダを含むファイル名取得の処理
        With wsTable
            For Each objSubFolder In objSubFolders
                If objSubFolder.Name <> "" Then
                    For i = 0 To cntEx
                        If InStr(objSubFolder.Name, ex(i)) > 0 Then
                            '通し番号
                            col = 1
                            .Cells(rowOutput, col).Value = rowOutput - 1
                            'ファイルパス
                            col = col + 1
                            .Cells(rowOutput, col).Value = objSubFolder.Path
                            'フォルダパス
                            col = col + 1
                            .Cells(rowOutput, col).Value = Replace(objSubFolder.Path, "\" & objSubFolder.Name, "")
                            'ファイル名
                            col = col + 1
                            .Cells(rowOutput, col).Value = objSubFolder.Name
                            '更新日
                            col = col + 1
                            .Cells(rowOutput, col) = Format(FileDateTime(objSubFolder), "yyyy/m/d")
                            
                            rowOutput = rowOutput + 1
                        End If
                    Next i
                    '再帰呼び出し
                    Call fileNameOutput(wsTable, objSubFolder.Path, fName, ex(), cntEx, rowOutput)
                End If
            Next objSubFolder
        End With
    
    End If
    
    Set objFSO = Nothing
    Set objFiles = Nothing
    Set objFile = Nothing
    Set objSubFolders = Nothing
    Set objSubFolder = Nothing
End Sub
Sub tableReset()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim col As Integer
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("一覧")
    
    With ws
        .Cells.ClearContents
        col = 1
        .Cells(1, col) = "通し番号"
        col = col + 1
        .Cells(1, col) = "ファイルパス"
        col = col + 1
        .Cells(1, col) = "フォルダパス"
        col = col + 1
        .Cells(1, col) = "ファイル名"
        col = col + 1
        .Cells(1, col) = "更新日"
    End With
    
    ws.Activate
    
    MsgBox "完了"
    
End Sub