'FilesystemEntry-Klasse
Option Explicit
Public name As String 'eines Unterordners oder einer Datei
Public IsFile As Boolean 'Ist es eine Datei?
Public Parent As Integer 'direkt übergeordneter Ordner (Arrayindex)

'FileList-Klasse
Option Explicit
 
Private Entries() As FilesystemEntry
 
Public Count As Integer
 
Private Sub Class_Initialize()
    ReDim Entries(1 To 1000) As FilesystemEntry
    Count = 0
End Sub
 
Private Sub Class_terminate()
    Count = 0
    ReDim Entries(0) As FilesystemEntry
End Sub
 
Public Function AddFilePath(Filepath As String) As Boolean
 
   'Eintragung einer Datei (kompletter Pfad)
 
   AddFilePath = False
 
   Dim parts() As String, i%, index%
 
   'Pfad in Teile zerlegen
   parts = Split(Filepath, "\", , vbTextCompare)
   If UBound(parts) < 2 Then Exit Function
 
   'fehlende Einträge in der Entry-Liste ergänzen
   Dim path As String, oldindex%
   oldindex = -1
   For i = 0 To UBound(parts)
      path = path & parts(i) & "\"
      If Not i = UBound(parts) Then
         'Ist der Eintrag des Teilpfades bereits vorhanden
         index = FindEntryByPath(path, False)
      End If
 
      If i = UBound(parts) Or index < 1 Then
 
         'Datei oder neuer Pfadteil wird ergänzt
         Count = Count + 1
         If Count >= UBound(Entries) Then
            'Array ggf. verlängern
            ReDim Preserve Entries(1 To UBound(Entries) + 1000)
         End If
 
         'neuer Eintrag
         Set Entries(Count) = New FilesystemEntry
         Entries(Count).name = Trim(UCase(parts(i)))
         Entries(Count).Parent = oldindex 'übergeordn. Entry
         If i = UBound(parts) Then Entries(Count).IsFile = True
         index = Count
      End If
      oldindex = index
   Next i
 
   AddFilePath = True
 
End Function
 
 
Private Function FindEntryByPath(ByVal path As String, _
 Optional ByVal GetFiles As Boolean = True) As Integer
 
   'Listen-Index einer Datei oder eines Ordners ermitteln
 
   Dim i%
   path = Trim(UCase(path))
   For i = 1 To Count
      If Entries(i).IsFile = GetFiles Then
         If path = GetPath(i) Then
            FindEntryByPath = i
            Exit Function
         End If
      End If
   Next i
   FindEntryByPath = -1
End Function
 
 
Private Function GetPath(ByVal index As Integer) As String
 
    'Zu einem Arrayindex den kompletten Pfad zusammenstellen
 
    GetPath = ""
    If index < 1 Or index > Count Then Exit Function
    Dim path$, i%
    i = index: path = ""
    Do
       path = Entries(i).name & "\" & path
       i = Entries(i).Parent
    Loop While i > 0
    GetPath = path
End Function
 
 
Public Sub GetEntries(FolderPath As String, ByRef FolderEntries$(), _
    Optional ByVal GetFiles As Boolean = True, _
    Optional ByVal GetFullPath As Boolean = True)
 
    'Alle Dateinamen (GetFiles=True) oder alle Unterordner (false)
    'im FolderPath zurückgeben (Angabe mit \ abschließen)
 
    Dim index%, i%, c%, ok As Boolean
 
    index = FindEntryByPath(FolderPath, False)
    If index < 1 Then
        ReDim FolderEntries(0)
        FolderEntries(0) = "Ordner nicht gefunden"
        Exit Sub
    End If
 
    ReDim FolderEntries(10)
    For i = 1 To Count
       If Entries(i).IsFile = GetFiles And Entries(i).Parent = index Then
 
          c = c + 1
          If UBound(FolderEntries) = c Then
             ReDim Preserve FolderEntries(c + 10)
          End If
          If Not GetFullPath Then
             FolderEntries(c) = Entries(i).name
          Else
             FolderEntries(c) = GetPath(i)
             FolderEntries(c) = _
                Mid$(FolderEntries(c), 1, Len(FolderEntries(c)) - 1)
          End If
       End If
    Next i
 
    ReDim Preserve FolderEntries(c)
End Sub