VBA100本ノック 26本目：ファイル一覧作成 - Infomentのブログ～Excel VBA奮闘記～

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。
f:id:Infoment:20220404203912p:plain

ファイル名や更新日時、サイズを取得するということで、今回は
FileSystemObjectを使用することにした。

Sub VBA_100Knock_026()
    'フォルダを選択。
    Dim FolderPath As String
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            On Error Resume Next
            FolderPath = .SelectedItems(1)
            ' キャンセルが押された場合。
            If Err.Number <> 0 Then Exit Sub
            On Error GoTo 0
        End With
        
    ' Microsoft Scripting Runtime参照設定。
    Dim FSO As Scripting.FileSystemObject
    Set FSO = New Scripting.FileSystemObject
    
    ' 指定フォルダ内のファイル数を取得。
    Dim iMax As Long
        iMax = FSO.GetFolder(FolderPath).Files.Count
        
        If iMax = 0 Then Exit Sub
    
    ' 取得結果を格納するための配列。
    Dim arr() As Variant
    ReDim arr(1 To iMax + 1, 1 To 4)
    ' ラベル情報作成。
        arr(1, 1) = "ファイル一覧"
        arr(1, 2) = "更新日時"
        arr(1, 3) = "サイズ"
        arr(1, 4) = "フルパス"
    
    Dim i As Long: i = 2
    Dim File As Scripting.File
        For Each File In FSO.GetFolder(FolderPath).Files
            arr(i, 1) = File.Name
            arr(i, 2) = File.DateLastModified
            arr(i, 3) = File.Size
            ' 表示する必要は無いが、ハイパーリンク用に格納しておく。
            arr(i, 4) = File.Path
            i = i + 1
        Next
    
    Dim Sh As Worksheet
        On Error Resume Next
    Set Sh = Sheets("ファイル一覧")
        If Err.Number <> 0 Then
            Set Sh = Sheets.Add
            Sh.Name = "ファイル一覧"
        Else
            Sh.Cells.Clear
        End If
        On Error GoTo 0
        
        Range("A1").Resize(iMax + 1, 3) = arr
    
    ' ハイパーリンク設定。Excelファイルのみ。
        For i = 2 To iMax + 1
            If FSO.GetExtensionName(arr(i, 4)) Like "xls?" Then
                ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
                                           Address:=arr(i, 4), _
                                           TextToDisplay:=arr(i, 1)
            End If
        Next
End Sub