Положите на форму ListBox и CommandButton и вставьте в ее модуль этот код:

Private Sub ListDir(ByVal Path As String)
Dim sSubDirs() As String
Dim sFile As String
Dim u As Long

List1.AddItem Path

ReDim sSubDirs(0)

If Right$(Path, 1) <> "\" Then
    Path = Path & "\"
End If
sFile = Dir(Path & "*.*", vbDirectory)
Do While Len(sFile)
    If sFile <> "." And sFile <> ".." Then
        If GetAttr(Path & sFile) And vbDirectory Then
            u = u + 1
            ReDim Preserve sSubDirs(u)
            sSubDirs(u) = sFile
        End If
    End If
    sFile = Dir
Loop

QuickSort sSubDirs(), 1, u

Dim i As Long
For i = 1 To u
    ListDir Path & sSubDirs(i)
Next i
End Sub

Private Sub QuickSort( _
        avarIn() As String, _
        ByVal intLowBound As Integer, _
        ByVal intHighBound As Integer)
  ' Source    : Total VB SourceBook 6
  Dim intX As Integer
  Dim intY As Integer
  Dim varMidBound As String
  Dim varTmp As String
  
  If intHighBound > intLowBound Then
    varMidBound = avarIn((intLowBound + _
        intHighBound) \ 2)
    intX = intLowBound
    intY = intHighBound
    
    Do While intX <= intY
      If avarIn(intX) >= varMidBound And _
         avarIn(intY) <= varMidBound _
      Then
        varTmp = avarIn(intX)
        avarIn(intX) = avarIn(intY)
        avarIn(intY) = varTmp
        intX = intX + 1
        intY = intY - 1
      Else
        If avarIn(intX) < varMidBound Then
          intX = intX + 1
        End If
        If avarIn(intY) > varMidBound Then
          intY = intY - 1
        End If
      End If
    Loop
    
    QuickSort avarIn(), intLowBound, intY
    QuickSort avarIn(), intX, intHighBound
  End If
End Sub

Private Sub Command1_Click()
ListDir "C:\"
End Sub