Quote Originally Posted by sheeeng
Well, the tabs on most left is very distracting for me. Sorry to mention it.
Plus, It list the name of folder repeatedly. (I don't know why.) Maybe too much file and folder contain in parent folder....
Try this


Option Explicit
Private FSO As Object
Private cnt As Long
Private arfiles
    
Private Const kFolder As String = "c:\myTest"
Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean
Set FSO = CreateObject("Scripting.FileSystemObject")
    arfiles = Array()
    cnt = -1
    ReDim arfiles(2, 0)
    If sFolder <> "" Then
        SelectFiles kFolder
        Application.DisplayAlerts = False
        On Error Resume Next
            Worksheets("Files").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        Worksheets.Add.Name = "Files"
        With ActiveSheet
            For i = LBound(arfiles, 2) To UBound(arfiles, 2)
                If arfiles(0, i) = "" Then
                    With .Cells(i + 1, 1)
                        .Value = arfiles(2, i)
                        .Font.Bold = True
                    End With
                    iStart = i + 1
                    iEnd = iStart
                    fOutline = False
                Else
                    .Hyperlinks.Add Anchor:=.Cells(i + 1, 2), _
                                    Address:=arfiles(0, i), _
                                    TextToDisplay:=arfiles(2, i)
                    iEnd = iEnd + 1
                End If
            Next
            .Columns("A:Z").Columns.AutoFit
        End With
    End If
End Sub


Sub SelectFiles(Optional sPath As String)
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath
arPath = Split(sPath, "\")
    cnt = cnt + 1
    ReDim Preserve arfiles(2, cnt)
    arfiles(0, cnt) = ""
    arfiles(2, cnt) = sPath
    Set oFolder = FSO.GetFolder(sPath)
    Set oFiles = oFolder.Files
    For Each oFile In oFiles
        cnt = cnt + 1
        ReDim Preserve arfiles(2, cnt)
        arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
        arfiles(1, cnt) = Right(oFile.Name, Len(oFile.Name) - _
            InStrRev(oFile.Name, "."))
        arfiles(2, cnt) = oFile.Name
    Next oFile
    For Each oSubFolder In oFolder.Subfolders
        SelectFiles oSubFolder.Path
    Next
End Sub