• Home
 · 
• Files/File Controls/Input/Output
 · 
• This code recursively searchs a given directory with all his subdirectories and puts the found file

This code recursively searchs a given directory with all his subdirectories and puts the found file

This code recursively searchs a given directory with all his subdirectories and puts the found filenames in a ListView ("lvFiles")

API Declarations


Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800

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




Rate This code recursively searchs a given directory with all his subdirectories and puts the found file

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    Screen.MousePointer = 11
    
    Dim li As ListItem
    Dim WFD As WIN32_FIND_DATA
    Dim hFile As Long, fPath As String, fName As String
    
    fPath = AddBackslash(Path)
    fName = fPath & "*.*"
    
    'Wir wollen hier mal alle Dateien im angegebenen Verzeichnis suchen.
    hFile = FindFirstFile(fName, WFD)
    If (hFile > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
        Set li = lvFiles.ListItems.Add(, , fPath & StripNulls(WFD.cFileName))        
    End If
    
    While FindNextFile(hFile, WFD)
        'Solange "FindNextFile" ausfuehren, bis keine Datei mehr gefunden wird, also hFile 0 ist.
        If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
            Set li = lvFiles.ListItems.Add(, , fPath & StripNulls(WFD.cFileName))        
        End If
    Wend
    
    If SubFolder Then
        
        'Wenn gewuenscht, dann werden hier alle Unterverzeichnisse durchsucht.
        hFile = FindFirstFile(fName, WFD)
        If (hFile > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
        StripNulls(WFD.cFileName) <> "." And StripNulls(WFD.cFileName) <> ".." Then
        
            'Das ist nun der rekursive Aufruf, die Funktion ruft sich selbst mit neuen Argumenten 
            '(in diesem Fall das Unterverzeichnis als "Path") auf.
            GetFiles fPath & StripNulls(WFD.cFileName), True
        End If
        
        While FindNextFile(hFile, WFD)
            If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
            StripNulls(WFD.cFileName) <> "." And StripNulls(WFD.cFileName) <> ".." Then

                'Wie oben, hier werden alle weiteren Unterverzeichnisse durchsucht
                GetFiles fPath & StripNulls(WFD.cFileName), True
            End If
        Wend
        
    End If
    FindClose hFile
    Set li = Nothing
    
    Screen.MousePointer = 0
End Sub

Private Function StripNulls(f As String) As String
    'Schneidet einen String nach dem ersten "Chr$(0)" ab, und gibt ihn zurueck. 
    StripNulls = Left$(f, InStr(1, f, Chr$(0)) - 1)
End Function

Private Function AddBackslash(S As String) As String
    'Fuegt zu einem String einen abschiessenden Backslash hinzu, wenn notwendig.
    If Len(S) Then
       If Right$(S, 1) <> "\" Then
          AddBackslash = S & "\"
       Else
          AddBackslash = S
       End If
    Else
       AddBackslash = "\"
    End If
End Function