Excel VBAでフォルダ内のファイルとフォルダをリスト化するコード

Sub sample_ListFilesAndFolders()
    Dim ws As Worksheet
    Dim folderPath As String
    Dim fso As Object
    Dim folder As Object
    Dim subFolder As Object
    Dim file As Object
    Dim row As Long
    Dim openFiles As Collection
    Dim openFile As Variant
    
    ' シートの指定と保存先パスの取得
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 必要に応じてシート名を変更してください
    folderPath = ws.Range("G1").Value
    
    ' フォルダパスが正しいか確認
    If folderPath = "" Then
        MsgBox "セルG1にフォルダパスを入力してください。"
        Exit Sub
    End If
    
    ' FileSystemObjectの作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' フォルダオブジェクトの取得
    On Error Resume Next
    Set folder = fso.GetFolder(folderPath)
    On Error GoTo 0
    
    If folder Is Nothing Then
        MsgBox "指定されたフォルダが存在しません。"
        Exit Sub
    End If
    
    ' 開いているファイルのリストを取得
    Set openFiles = New Collection
    For Each openFile In Application.Workbooks
        openFiles.Add LCase(openFile.Name)
    Next openFile
    
    ' データ書き込み開始行
    row = 2
    
    ' フォルダ内のアイテムを列挙
    For Each subFolder In folder.SubFolders
        ws.Cells(row, 2).Value = "フォルダ"
        ws.Cells(row, 3).Value = subFolder.Name
        ws.Hyperlinks.Add Anchor:=ws.Cells(row, 4), Address:=subFolder.Path, TextToDisplay:=subFolder.Path
        row = row + 1
    Next subFolder
    
    For Each file In folder.Files
        ' 一時ファイルと開いているファイルを除外
        If Not file.Name Like "~$*" And _
           LCase(fso.GetExtensionName(file.Name)) <> "tmp" And _
           Not IsInCollection(openFiles, LCase(file.Name)) Then
            ws.Cells(row, 2).Value = "ファイル"
            ws.Cells(row, 3).Value = file.Name
            ws.Hyperlinks.Add Anchor:=ws.Cells(row, 4), Address:=file.Path, TextToDisplay:=file.Path
            row = row + 1
        End If
    Next file
    
    MsgBox "書き出しが完了しました。"
End Sub

' コレクションにアイテムが含まれているかを確認する関数
Function IsInCollection(coll As Collection, item As String) As Boolean
    Dim elem As Variant
    IsInCollection = False
    For Each elem In coll
        If elem = item Then
            IsInCollection = True
            Exit Function
        End If
    Next elem
End Function