【VBAマクロ】あるフォルダのファイルを一覧化する

雛形

VBAマクロソースコード

Option Explicit
Dim CountRow As Long

Sub FILESHOW()

    Dim FilePathName As String
    Dim cell_array(2) As String
    
    'マクロ負荷計測
    Dim TIMEIN As Single
    Dim TIMEOUT As Single
    Dim TIMEDIFF As Single
    TIMEIN = Timer
    
    '画面描画の停止
    Call ScreenDrawStop(True)
    
    Dim row As Integer
    
    For row = 3 To 10
    
        Sheets("FileSearch").Select
        
        'FolderPath
        cell_array(0) = Range("C" & row).Value
        FilePathName = cell_array(0)
        
        'GetData Flag
        cell_array(1) = Range("D" & row).Value
        
        'Sheet Name
        cell_array(2) = Range("E" & row).Value
        
        If cell_array(1) = "○" Then
        
            Sheets(cell_array(2)).Select
            
            '//CELL内容をクリアする
            Cells.ClearContents
            Range("B2").Value = "No."
            Range("C2").Value = "Folder Path"
            Range("D2").Value = "File Name"
            Range("E2").Value = "DateCreated"
            Range("F2").Value = "Date Last Modified"
            Range("G2").Value = "File Size(KB)"
            
            CountRow = 0
            
            Call searchAllDirFile(FilePathName)
            
            Sheets("FileSearch").Select
            Cells(row, 6).Value = CountRow
            
        End If
        
    Next row
    
    '画面描画の再開
    Call ScreenDrawStop(False)
    
    TIMEOUT = Timer
    TIMEDIFF = TIMEOUT - TIMEIN
    
    MsgBox "行" & row - 1 & "までデータ反映完了。お疲れ様でした!" & vbCrLf & "処理にかかった時間は" & Round(TIMEDIFF, 1) & "秒です。"

End Sub
Sub ScreenDrawStop(ByVal Flag As Boolean)

    With Application
        .EnableEvents = Not Flag
        .ScreenUpdating = Not Flag
        .Calculation = IIf(Flag, xlCalculationManual, xlCalculationAutomatic)
    End With
    
End Sub

Sub searchAllDirFile(a_sFolder As String)

    Dim oFso As FileSystemObject
    Dim oFolder As Folder
    Dim oSubFloder As Folder
    Dim oFile
    
    Set oFso = CreateObject("Scripting.FileSystemObject")
    
    '//フォルダがない場合
    If (oFso.FolderExists(a_sFolder) = False) Then
        Exit Sub
    End If
    
    Set oFolder = oFso.GetFolder(a_sFolder)
    
    '//サブフォルダを再帰(サブフォルダを探す必要がない場合はこのFor文を削除してください)
    For Each oSubFloder In oFolder.SubFolders
        
        Call searchAllDirFile(oSubFloder.Path)
    
    Next
    
    '//カレントフォルダ内のファイルを取得
    For Each oFile In oFolder.Files
        '//ファイル名を出力
        '//Debug.PrintoFile. ParentFolder & oFile.Name
        'If (oFile.Name Like "*.xls*") Then
        If (oFile.Name Like "*.*") Then
            Range("B3").Offset(CountRow, 0).Value = CountRow + 1
            Range("C3").Offset(CountRow, 0).Value = oFile.ParentFolder
            Range("D3").Offset(CountRow, 0).Value = oFile.Name
            Range("E3").Offset(CountRow, 0).Value = oFile.DateCreated
            Range("F3").Offset(CountRow, 0).Value = oFile.DateLastModified
            Range("G3").Offset(CountRow, 0).Value = oFile.Size / 1024
            CountRow = CountRow + 1
        End If
    Next
End Sub