Try the free Excel add-in "List Files" at...
http://www.realezsites.com/bus/primitivesoftware
No registration required

Option Explicit

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean

   arfiles = Array()
   cnt = -1
   level = 1

   sFolder = "E:\"
   ReDim arfiles(2, 0)
   If sFolder <> "" Then
       SelectFiles sFolder
       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
                   If fOutline Then
                       Rows(iStart + 1 & ":" & iEnd).Rows.Group
                   End If
                   With .Cells(i + 1, arfiles(2, i))
                       .Value = arfiles(1, i)
                       .Font.Bold = True
                   End With
                   iStart = i + 1
                   iEnd = iStart
                   fOutline = False
               Else
                   .Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
                                   Address:=arfiles(0, i), _
                                   TextToDisplay:=arfiles(1, i)
                   iEnd = iEnd + 1
                   fOutline = True
               End If
           Next
           .Columns("A:Z").ColumnWidth = 5
       End With
   End If
   'just in case there is another set to group
   If fOutline Then
       Rows(iStart + 1 & ":" & iEnd).Rows.Group
   End If

   Columns("A:Z").ColumnWidth = 5
   ActiveSheet.Outline.ShowLevels RowLevels:=1
   ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

   If FSO Is Nothing Then
       Set FSO = CreateObject("Scripting.FileSystemObject")
   End If

   If sPath = "" Then
       sPath = CurDir
   End If

   arPath = Split(sPath, "\")
   cnt = cnt + 1
   ReDim Preserve arfiles(2, cnt)
   arfiles(0, cnt) = ""
   arfiles(1, cnt) = arPath(level - 1)
   arfiles(2, cnt) = level

   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) = oFile.Name
       arfiles(2, cnt) = level + 1
   Next oFile

   level = level + 1
   For Each oSubFolder In oFolder.Subfolders
       SelectFiles oSubFolder.Path
   Next
   level = level - 1

End Sub

#If VBA6 Then
#Else
'-----------------------------­­-----------------------------­-­------
Function Split(Text As String, _
       Optional Delimiter As String = ",") As Variant
'-----------------------------­­-----------------------------­-­------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

   If Delimiter = vbNullChar Then
       Delimiter = Chr(7)
       Text = Replace(Text, vbNullChar, Delimiter)
   End If

   sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") &
"""}"
   aryEval = Evaluate(sFormula)
   ReDim aryValues(0 To UBound(aryEval) - 1)
   For i = 0 To UBound(aryValues)
           aryValues(i) = aryEval(i + 1)
   Next

   Split = aryValues

End Function

'---------------------------------------------------------------------------
Public Function InStrRev(stringcheck As String, _
                        ByVal stringmatch As String, _
                        Optional ByVal start As Long = -1)
'---------------------------------------------------------------------------
Dim iStart As Long
Dim iLen As Long
Dim i As Long

   If iStart = -1 Then
       iStart = Len(stringcheck)
   Else
       iStart = start
   End If

   iLen = Len(stringmatch)

   For i = iStart To 1 Step -1
       If Mid(stringcheck, i, iLen) = stringmatch Then
           InStrRev = i
           Exit Function
       End If
   Next i
   InStrRev = 0
End Function
'-----------------------------------------------------------------
#End If