Dim strFindWhat As String
   Dim i As Integer
   Dim strStart As String
 
 
    CDlg.ShowOpen
    If CDlg.filename = "" Then Exit Sub
    'Dateiendung ermitteln
    strFindWhat = "*" & Right(CDlg.filename, 4)
 
 
 
    'Pfad ermitteln; Dateiname wird abgeschnitten
 
    For i = Len(CDlg.filename) - 1 To 1 Step -1
 
        If Mid(CDlg.filename, i, 1) = "\" Then
 
            strStart = Left(CDlg.filename, i)
 
            Exit For
 
        End If
 
    Next
 
 
 
    lstFiles.Clear
 
 
 
    Call FindSub(strStart, strFindWhat)
 
 
 
3. Geben Sie für den eigentlichen Suchalgorithmus folgende beiden Prozeduren _
  ein.
 
 
 
' FindSub() ermittelt alle Dateien mit der im Commondialog
 
' ausgewählten Dateiendung bis zur untersten Ebene ab dem gewählten Verzeichnis.
 
' Hierzu wird ein rekursiver Aufruf der Routine FindSub() eingesetzt.
 
 
 
Sub FindSub(strStart As String, strFindWhat As String)
 
   Dim arrFindDir() As String
 
   Dim strFind As String
 
   Dim i As Integer
 
 
 
   ChDrive (Left(strStart, 3))
 
   ChDir (strStart)
 
 
 
   Call DirSub(strFindWhat, strStart)
 
 
 
   strFind = Dir("*.*", vbDirectory)
 
   i = 0
 
 
 
   ' ermittelt alle vorhandenen Dateien und Verzeichnisse im aktuellen 
   ' Verzeichnis
 
   Do Until strFind = ""
 
      ReDim Preserve arrFindDir(i)
 
      arrFindDir(i) = strFind
 
      i = i + 1
 
      strFind = Dir()
 
   Loop
 
 
 
   For i = 0 To UBound(arrFindDir)
      ' If... ermittelt ob es sich um ein Verzeichnis handelt
      ' und verzweigt dann rekursiv in dieses Verzeichnis
      If Dir(arrFindDir(i), vbNormal) = "" And Left(arrFindDir(i), 1) <> "." Then
         ' Rekursiver Aufruf von FindSub
         Call FindSub(strStart & arrFindDir(i) & "\", strFindWhat) 
         ChDir (strStart)
       End If
   Next
End Sub
' ermittelt alle gesuchten Dateien im momentan aktuellen Verzeichnis
' und gibt die gefundenen Dateien mit Pfad in eine Listenfeld (lstFiles) aus.
 
 
Sub DirSub(strFindWhat, strStart)
 
 
   Dim strFindfile As String
 
 
   strFindfile = Dir(strFindWhat, vbNormal)
 
 
    Do While strFindfile <> ""
 
        lstFiles.AddItem strStart & strFindfile
 
        strFindfile = Dir()
 
    Loop
 
End Sub