' rekursive Funktion, die alle Dateien eines Ordners in eine Listbox hinzufügt
' inklusive Unterordner
Private Function GetExtension(ByVal Path As String) As String
  On Error Resume Next
  If InStr(InStrRev(Path, "\"), Path, ".") > 0 Then
    GetExtension = Mid(Path, InStrRev(Path, ".") + 1)
  End If
End Function
 
Private Sub ListFiles(ByRef cFiles As Collection, ByVal sFolder As String, _
  ByVal sExtension As String)
 
  On Error Resume Next
  Dim sCurrent As String
  Dim cFolders As New Collection
  Dim i As Integer
  sExtension = LCase(sExtension)
  If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
  ' Ordner durchsuchen
  sCurrent = Dir(sFolder & "*.*", _
    vbArchive + vbHidden + vbReadOnly + vbSystem + vbDirectory)
  While sCurrent <> ""
    If sCurrent <> "." And sCurrent <> ".." Then
      If GetAttr(sFolder & sCurrent) And vbDirectory Then
        cFolders.Add sCurrent
      Else
        If LCase(GetExtension(sCurrent)) = sExtension Then
          cFiles.Add sFolder & sCurrent
        End If
      End If
    End If
    sCurrent = Dir()
  Wend
  ' Unterordner durchgehen
  For i = 1 To cFolders.Count
    ListFiles cFiles, sFolder & cFolders(i), sExtension
  Next i
End Sub

Dim cFiles As New Collection
ListFiles cFiles, "C:\", "txt"
Dim i As Integer
For i = 1 To cFiles.Count
  Debug.Print cFiles(i)
Next i

Web: http://www.vbtricks.de.vu/

VBTricks.de.vu. Meine Webseite zu VB und anderen Programmiersprachen. Verschiedene fortgeschrittene OCXe und komplette Projekte sind im Sourcecode verf?gbar.