Semi-Recursive Search with Dir

[|2eM!x]

Option Explicit
Dim i As Long
Dim MyCount As Long
 
Private Function GetFolder(iPath As String) As String
Dim MyDir As String, x As Long
    MyDir = Dir(iPath, vbDirectory): i = 0
        Do Until MyDir = ""
            If InStr(MyDir, ".") = 0 Then
                 list1.AddItem MyDir
            End If
            MyDir = Dir
        Loop
        MyCount = list1.ListCount
    Do Until i >= MyCount
    DoEvents
    MyCount = list1.ListCount
        Do Until InStr(list1.List(i), "-") = 0
            i = i + 1
        Loop
                    Call Get2Folder(iPath & list1.List(i) & "\")
                i = i + 1
    Loop
End Function
 
Private Function Get2Folder(iFolder As String) As String
Dim iDir As String
    iDir = Dir(iFolder, vbDirectory)
        Do Until iDir = ""
            If InStr(iDir, ".") = 0 And Len(iDir) > 1 Then
                 list1.AddItem "-" & iDir, i + 1
            End If
            iDir = Dir
        Loop
End Function
 
Private Sub Form_Activate()
    Call GetFolder("C:\Program Files\")
End Sub