Try this:

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)
    'First get number of folders (Stored in
    '     i)


    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 each folder check to see there are


'     sub folders


    For x = 1 To i
        Call DirMap(Temp & Fname(x) & "\", List)
    Next
End Sub



Usage:

Private Sub Command1_Click()
    Call DirMap("C:\Windows\", List1)
    'Must have "\" at the end of the path
End Sub