'clsUnterordner
Private m_objUnterordner As clsDetails 
private m_strOrdername as string
private m_strOrdnerpfad as string
Private Sub Class_Initialize()
    Set m_objUnterordner = New clsDetails
End Sub
Private Sub Class_Terminate()
    Set m_objUnterordner = Nothing
End Sub
 
Public Property Get Unterordner(vntIndex As Variant) As clsDetails
Set Unterordner = m_objUnterordner(vntIndex)
End Property
Public Property Get Anzahl() As Long
Anzahl = m_objUnterordner.Count
End Property
Public Property Get Ordnerpfad() As string
Ordnerpfad = m_strOrdnerpfad
End Property
Public Property Get Ordnername() As string
Ordnername = m_strOrdnername
End Property
Public Property Let Ordnerpfad(strOrdnerpfad As String)
m_strOrdnerpfad = strOrdnerpfad
End Property
Public Property Let Ordnername(strOrdnername As String)
m_strOrdnername = strOrdnername
End Property
Public Function UnterordnerHinzufügen(strUnterordnername As String, _
  strUnterordnerpfad As  _
String)
    Dim objDatei As clsDetails
    If Exists(strUnterordnername & strUnterordnerpfad) Then
        MsgBox "Dieser Eintrag existiert bereits"
    Else
        Set objUnterordner = New clsDetails
        objUnterordner.Name = strUnterordnername
        objUnterordner.Pfad = strUnterordnerpfad
        m_objUnterordner.Add objUnterordner, strUnterordnername & _
          strUnterordnerpfad
    End If
End Function
Public Function Exists(vntIndex As Variant) As Boolean
On Error Resume Next
    Exists = Not CBool(m_objUnterordner(vntIndex) Is Nothing)
End Function
Public Sub Remove(vntIndex As Variant)
    m_objUnterordner.Remove vntIndex
End Sub
 
 
'clsDetails
Private m_strName As String
Private m_strPfad As String
Public Property Get Name() As String
Name = m_strName
End Property
Public Property Get Pfad() As String
Pfad = m_strPfad
End Property
Public Property Let Name(strName As String)
m_strName = strName
End Property
Public Property Let Pfad(strPfad As String)
m_strPfad = strPfad
End Property

'clsUnterordner
Option Explicit
Private m_objUnterordner As Collection
 
Private Sub Class_Initialize()
    Set m_objUnterordner = New Collection
End Sub
Private Sub Class_Terminate()
    Set m_objUnterordner = Nothing
End Sub
Public Property Get UnterordnerIndex(vntIndex As Variant) As clsEigenschaften
    Set UnterordnerIndex = m_objUnterordner(vntIndex)
End Property
Public Property Get Unterordner() As Collection
    Set Unterordner = m_objUnterordner
End Property
Public Property Get UnterordnerAnzahl() As Long
    UnterordnerAnzahl = m_objUnterordner.Count
End Property
Public Function UnterordnerHinzufügen(strPfad As String, strName As String)
    Dim objUnterordner As clsEigenschaften
    If Exists(strPfad & strName) Then
        MsgBox "Dieser Eintrag existiert bereits"
    Else
        Set objUnterordner = New clsEigenschaften
        objUnterordner.Pfad = strPfad
        objUnterordner.Name = strName
        m_objUnterordner.Add objUnterordner, strPfad & strName
    End If
End Function
Public Function Exists(vntIndex As Variant) As Boolean
On Error Resume Next
    Exists = Not CBool(m_objUnterordner(vntIndex) Is Nothing)
End Function
Public Sub Remove(vntIndex As Variant)
    m_objUnterordner.Remove vntIndex
End Sub

'clsDatei
Option Explicit
Private m_objDatei As Collection
 
Private Sub Class_Initialize()
    Set m_objDatei = New Collection
End Sub
Private Sub Class_Terminate()
    Set m_objDatei = Nothing
End Sub
Public Property Get DateiIndex(vntIndex As Variant) As clsEigenschaften
    Set DateiIndex = m_objDatei(vntIndex)
End Property
Public Property Get Datei() As Collection
    Set Datei = m_objDatei
End Property
Public Property Get DateiAnzahl() As Long
    DateiAnzahl = m_objDatei.Count
End Property
Public Function DateiHinzufügen(strPfad As String, strName As String)
    Dim objDatei As clsEigenschaften
    If Exists(strPfad & strName) Then
        MsgBox "Dieser Eintrag existiert bereits"
    Else
        Set objDatei = New clsEigenschaften
        objDatei.Pfad = strPfad
        objDatei.Name = strName
        m_objDatei.Add objDatei, strPfad & strName
    End If
End Function
Public Function Exists(vntIndex As Variant) As Boolean
On Error Resume Next
    Exists = Not CBool(m_objDatei(vntIndex) Is Nothing)
End Function
Public Sub Remove(vntIndex As Variant)
    m_objDatei.Remove vntIndex
End Sub

'clsEigenschaften
Option Explicit
Private m_strName As String
Private m_strPfad As String
 
Public Property Get Name() As Date
    Name = m_strName
End Property
Public Property Get Pfad() As String
    Pfad = m_strPfad
End Property
 
Public Property Let Name(strName As String)
    m_strName = strName
End Property
Public Property Let Pfad(strPfad As String)
    m_strPfad = strPfad
End Property

'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