Here you go:
Code:
Sub DirMap(ByVal Path As String, List As ListBox)
On Error Resume Next
Dim i, j, x As Integer 'All used as counters
Dim Fname(), CurrentFolder, Temp As String
Temp = Path
If Dir(Temp, vbDirectory) = "" Then Exit Sub 'if there arent any sub directories the exit
CurrentFolder = Dir(Temp, vbDirectory)
Do While CurrentFolder <> ""
If GetAttr(Temp & CurrentFolder) = vbDirectory Then
If CurrentFolder <> "." And CurrentFolder <> ".." Then
i = i + 1
End If
End If
CurrentFolder = Dir
Loop
ReDim Fname(i) 'Redim the array With number of folders
'now store the folder names
CurrentFolder = Dir(Temp, vbDirectory)
Do While CurrentFolder <> ""
If GetAttr(Temp & CurrentFolder) = vbDirectory Then
If CurrentFolder <> "." And CurrentFolder <> ".." Then
j = j + 1
Fname(j) = CurrentFolder
List.AddItem Temp & Fname(j)
End If
End If
CurrentFolder = Dir
Loop
For x = 1 To i
Call DirMap(Temp & Fname(x) & "\", List)
Next
End Sub
Usage
Private Sub Command1_Click()
Call DirMap("C:\", List1)
DoEvents
Msgbox List1.ListCount & " - Folders on C drive."
End Sub