CodeItBetter Programming Another VB Programming Blog

'File/Folder Handling - How to Find Files (in two ways)

Option Explicit
 
'Using API

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" _
    (ByVal lpFileName As String) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Const MAX_PATH = 260
Public Const MAXDWORD = &HFFFF
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
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
 
Public Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr,  chr ( 0 ) ) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr,  chr ( 0 ) ) - 1)
    End If
    StripNulls = OriginalStr
End Function
 
Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
    Dim FileName As String
    Dim DirName As String
    Dim dirNames() As String
    Dim nDir As Integer
    Dim i As Integer
    Dim hSearch As Long
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer
    If Right(path, 1) <> "\" Then path = path & "\"
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
            DirName = StripNulls(WFD.cFileName)
            If (DirName <> ".") And (DirName <> "..") Then
                If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
                    dirNames(nDir) = DirName
                    DirCount = DirCount + 1
                    nDir = nDir + 1
                    ReDim Preserve dirNames(nDir)
                End If
            End If
            Cont = FindNextFile(hSearch, WFD)
        Loop
        Cont = FindClose(hSearch)
    End If
    hSearch = FindFirstFile(path & SearchStr, WFD)
    Cont = True
    If hSearch <> INVALID_HANDLE_VALUE Then
        While Cont
            FileName = StripNulls(WFD.cFileName)
            If (FileName <> ".") And (FileName <> "..") Then
                FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
                FileCount = FileCount + 1
                List1.AddItem path & FileName
            End If
            Cont = FindNextFile(hSearch, WFD)
        Wend
        Cont = FindClose(hSearch)
    End If
    If nDir > 0 Then
        For i = 0 To nDir - 1
            FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
        Next i
    End If
End Function
 
'Add a Command Button, 4 Text Boxes and a List Box to your Form.
'At Run-time, Enter the path that you want to start to search from it in Text1,
'Enter the file pattern to Text2 (like *.* or  *.dll), and click the command button.
'List1 will be filled with all the matching files, Text3 will display the number of files found,
'And Text4 will display the total size of the files found.

Private Sub Command1_Click()
    Dim SearchPath As String, FindStr As String
    Dim FileSize As Long
    Dim NumFiles As Integer, NumDirs As Integer
    Screen.MousePointer = vbHourglass
    List1.Clear
    SearchPath = Text1.Text
    FindStr = Text2.Text
    FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
    Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & " Directories"
    Text4.Text = "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes"
    Screen.MousePointer = vbDefault
End Sub
 
'Without Using API:

Function FindFiles(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
    Dim FileName As String
    Dim DirName As String
    Dim dirNames() As String
    Dim nDir As Integer
    Dim i As Integer
    On Error GoTo sysFileERR
    If Right(path, 1) <> "\" Then path = path & "\"
    nDir = 0
    ReDim dirNames(nDir)
    DirName = Dir(path, vbDirectory Or vbHidden)
    Do While Len(DirName) > 0
        If (DirName <> ".") And (DirName <> "..") Then
            If GetAttr(path & DirName) And vbDirectory Then
                dirNames(nDir) = DirName
                DirCount = DirCount + 1
                nDir = nDir + 1
                ReDim Preserve dirNames(nDir)
            End If
sysFileERRCont:
        End If
        DirName = Dir()
    Loop
    FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
    While Len(FileName) <> 0
        FindFiles = FindFiles + FileLen(path & FileName)
        FileCount = FileCount + 1
        List1.AddItem path & FileName
        FileName = Dir()
    Wend
    If nDir > 0 Then
        For i = 0 To nDir - 1
            FindFiles = FindFiles + FindFiles(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
        Next i
    End If
AbortFunction:
    Exit Function
sysFileERR:
    If Right(DirName, 4) = ".sys" Then
        Resume sysFileERRCont
    Else
        MsgBox "Error: " & Err.Number & " - " & Err.Description, , "Unexpected Error"
        Resume AbortFunction
    End If
End Function
 
'Add a Command Button, 4 Text Boxes and a List Box to your Form.
'At Run-time, Enter the path that you want to start to search from it in Text1,
'Enter the file pattern to Text2 (like *.* or  *.dll), and click the command button.
'List1 will be filled with all the matching files, Text3 will display the number of files found,
'And Text4 will display the total size of the files found.

Private Sub Command1_Click()
    Dim SearchPath As String, FindStr As String
    Dim FileSize As Long
    Dim NumFiles As Integer, NumDirs As Integer
    Screen.MousePointer = vbHourglass
    List1.Clear
    SearchPath = Text1.Text
    FindStr = Text2.Text
    FileSize = FindFiles(SearchPath, FindStr, NumFiles, NumDirs)
    Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & " Directories"
    Text4.Text = "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes"
    Screen.MousePointer = vbDefault
End Sub