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




Reply With Quote