Hi
find below a repost from Bob Phillips. Change the starting directory
and use the macro 'Folders'
Frank
Dim FSO As Object
Dim cnt As Long
Dim level As Long
Dim arFiles
Sub Folders()
Dim i As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
arFiles = Array()
cnt = 0
level = 1
ReDim arFiles(1, 0)
arFiles(0, 0) = "C:\myTest"
arFiles(1, 0) = level
SelectFiles "C:\myTest"
cnt = 0
For i = LBound(arFiles, 2) To UBound(arFiles, 2)
ActiveSheet.Cells(i + 1, arFiles(1, i)).Value = arFiles(0, i)
Next
End Sub
'----------------------------------------------------------------------
Sub SelectFiles(sPath)
'----------------------------------------------------------------------
Dim fldr As Object
Dim Folder As Object
Set Folder = FSO.Getfolder(sPath)
level = level + 1
For Each fldr In Folder.Subfolders
cnt = cnt + 1
ReDim Preserve arFiles(1, cnt)
arFiles(0, cnt) = fldr.Name
arFiles(1, cnt) = level
SelectFiles fldr.Path
level = level - 1
Next
End Sub