call ListDirectoryTree("C:\temp\")

Option Explicit
 
    Private Declare Function PathIsDirectoryEmpty Lib "shlwapi.dll" Alias _
      "PathIsDirectoryEmptyA" (ByVal pszPath As String) As Long
    Private Declare Function PathIsDirectory Lib "shlwapi.dll" Alias _
    "PathIsDirectoryA" (ByVal pszPath As String) As Long
 
Public Function PathIsDotted(strPath As String) As Boolean
 
    strPath = Trim$(strPath)
    If Left$(strPath, 1) = "." Then
        PathIsDotted = True
    Else
        PathIsDotted = False
    End If
 
End Function
 
Public Function PathRemoveDots(strPath As String) As Long
 
    strPath = Trim$(strPath)
    If InStr(1, strPath, ".", 1) <> 0 Then
        strPath = Replace$(strPath, ".", "", Compare:=1)
    End If
 
    PathRemoveDots = 0
 
End Function
 
Public Function PathAddDir(strPath As String, strDir As String) As Boolean
 
    PathAddDir = False
 
    Dim strTMP As String
    strPath = Trim$(strPath)
    strDir = Trim$(strDir)
    If Len(strPath) = 0 Then Exit Function
    If Len(strDir) = 0 Then Exit Function
    PathAddBackslash strPath
    PathAddBackslash strDir
    strTMP = strPath & strDir
    If PathIsDirectory(strTMP) = vbDirectory Then
        strPath = strTMP
        PathAddDir = True
    End If
 
End Function
 
Public Function PathAddBackslash(strPath As String) As Long
 
    strPath = Trim$(strPath)
    If Right$(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
 
    PathAddBackslash = 0
 
End Function
 
 
Public Function ListDirectoryTree(ByVal strPath As String) As Boolean
 
    Dim strPTH As String
    Dim strTMP As String
    Dim lngLEN As Long
    Dim lngRET As Long
 
    ListDirectoryTree = False
 
    strPTH = strPath
    lngRET = PathAddBackslash(strPTH)
    lngRET = PathIsDirectory(strPTH)
    If lngRET <> vbDirectory Then
        Exit Function
    End If
 
    Dim colXItems As New Collection
    Dim colDirItems As New Collection
    Dim varItem As Variant
    Dim lngCnt As Long
    colDirItems.Add strPTH, strPTH
 
    Do Until lngCnt = colDirItems.Count
        lngCnt = colDirItems.Count
        For Each varItem In colDirItems
            strTMP = Dir$(varItem, vbDirectory)
            Do Until strTMP = vbNullString
                Do While PathIsDotted(strTMP)
                    strTMP = Dir$
                Loop
                If strTMP = vbNullString Then
                    Exit Do
                End If
                strPTH = varItem
                If PathAddDir(strPTH, strTMP) Then
                    colDirItems.Add strPTH, strPTH
                End If
                strTMP = Dir$
            Loop
            colXItems.Add varItem, varItem
            colDirItems.Remove varItem
        Next varItem
        DoEvents
    Loop
 
    For Each varItem In colXItems
        ' hier sind die Pfade
        Debug.Print CStr(varItem)
    Next varItem
 
    Set colDirItems = Nothing
    Set colXItems = Nothing
 
    ListDirectoryTree = True
 
End Function

Ohne Mampf, kein Kampf !