Private Const MAX_PATH = 260
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
  ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As _
Long
Dim files As Collection
Dim break As Boolean
 
Private Sub Command1_Click()
    If (Command1.Caption = "Suchen") Then
        Set files = New Collection
        Command1.Caption = "Abbrechen"
        break = False
        getDir "C:\"
        Label1.Caption = files.Count
        Command1.Caption = "Suchen"
    Else
        break = True
    End If
End Sub
 
Private Sub getDir(path As String)
    Dim ffd As WIN32_FIND_DATA
    Dim handle As Long
    Dim l_success As Long
    Dim l_filename As String
    handle = FindFirstFile(path & "\*.*", ffd)
    If (handle = -1) Then Exit Sub
    If (l_success <> 0) Then
        Debug.Print path & Left(ffd.cFileName, InStr(1, ffd.cFileName, Chr(0)) _
          - 1)
    End If
    Do
        l_success = FindNextFile(handle, ffd)
        l_filename = Mid(ffd.cFileName, 1, InStr(1, ffd.cFileName, Chr(0)) - 1)
        If (l_success <> 0) Then
            If (l_filename <> "." And l_filename <> "..") Then
                files.Add path & IIf(Right(path, 1) = "\", "", "\") & l_filename
'                Debug.Print path & IIf(Right(path, 1) = "\", "", "\") & 
' l_filename
 
                ' Verzeichnis
'                On Error Resume Next
                If ((ffd.dwFileAttributes And vbDirectory) = vbDirectory) Then
                    getDir path & IIf(Right(path, 1) = "\", "", "\") & _
                      l_filename
                Else
                ' Datei
 
                End If
            End If
        End If
        DoEvents
    Loop Until (l_success = 0) Or (break = True)
End Sub