And you can make this code recursive
[vba]
Option Explicit

Dim i As Long, j As Long
Dim searchfolders As Variant
Dim FileSystemObject

Sub ListOfFolders()
Dim LookInTheFolder As String

i = 1
LookInTheFolder = "C:\" ' As you know; you should modificate this row.
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
For Each searchfolders In FileSystemObject.GetFolder(LookInTheFolder).SubFolders
Cells(i, 1) = searchfolders
i = i + 1
SearchWithin searchfolders
Next searchfolders

End Sub

Sub SearchWithin(searchfolders)
On Error GoTo exits
For Each searchfolders In FileSystemObject.GetFolder(searchfolders).SubFolders
j = UBound(Split(searchfolders, "\"))
Cells(i, j) = searchfolders
i = i + 1
SearchWithin searchfolders
Next searchfolders
exits:
End Sub



[/vba]