Recursive File Search
(including Sub-Directories)

and

Listbox
Horizontal Scrollbar

in Visual Basic®




by Rick Meyer          Home

When you run the program:

  • Choose a start directory from the DirListBox.
  • Choose a file type from the Combobox.
  • Click the CommandButton to start the search.
  • Type in a file extension in the ComboBox if the one you want is not listed.
  • To search for matches in any portion of the filename, uncheck the checkbox
    (type your search string in the combobox).
    •     Instructions for Building the Project:

    1. Start a new standard exe.
    2. On Form1 put a Label named Label1.
    3. On Form1 put a ListBox named List1.
    4. On Form1 put a Checkbox named Check1.
    5. On Form1 put a DirListBox named Dir1.
    6. On Form1 put a CommandButton named Command1.
    7. On Form1 put a ComboBox named Combo1.
    8. Set the Combo1.Height property to 315.

    There is no need to position or size the above controls
    on the form since that is all done in the Form_Load.

    Now you are ready for the code. Select all of the following code (by clicking on the word 'Option' three times) and copy it to the clipboard [Ctrl][Insert]. Then paste it into the code window of Form1 with [Shift][Insert]. Variable Key
    % As Integer
    & As Long
    ! As Single
    # As Double
    $ As String 
    '========================================================
'                    File Search
'        by: Rick Meyer       date: July 2001
'========================================================
' File Name:   fileSrch.frm
' Object Name: Form1
' Description: Interface and code to:
'              • Search for files recursively
'              • Add a listbox horizontal scrollbar
'========================================================

Option Explicit

'========================================================
' API declarations for the file searching operations
'========================================================
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_DIRECTORY = &H10

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 * 260
  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

'========================================================
' API declarations for
'   adding the listbox horizontal scrollbar
'========================================================
Const LB_SETHORIZONTALEXTENT = &H194

Private Declare Function SendMessageByNum _
    Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long


'========================================================
' Module level program variables
'========================================================
Dim Num%, maxWdth&

Private Sub Command1_Click()
    Num = 0
    maxWdth = 0
    
    List1.Clear
    searchForFiles Dir1.Path, Combo1.Text
    
    'Determine the width to pass to the API
    maxWdth = maxWdth + TextWidth("  ")
    maxWdth = maxWdth / Screen.TwipsPerPixelX
    
    'The API call to add the horizontal scrollbar
    SendMessageByNum List1.hwnd, _
        LB_SETHORIZONTALEXTENT, maxWdth, 0

    If Num = 0 Then Label1.Caption = "No Files Found"
End Sub

Private Sub searchForFiles( _
        ByVal startPath$, ByVal match$)
    Dim fPath$, fName$, fPathName$
    Dim hfind&, nameLen%, matchLen%
    Dim WFD As WIN32_FIND_DATA
    Dim found As Boolean
    
    fPath = startPath
    If Right(fPath, 1) <> "\" Then
        fPath = fPath & "\"
    End If
    
    matchLen = Len(match)
    match = LCase$(match)
    
    'The first API call is to FindFirstFile.
    '  Note that we get get all files with a "*"
    '  and not specify just the file extension
    '  because we need to get the directories too.
    hfind = FindFirstFile(fPath & "*", WFD)
    found = (hfind > 0)
    
    Do While found
        fName = TrimNull(WFD.cFileName)
        nameLen = Len(fName)
        fPathName = fPath & fName
        
        If fName = "." Or fName = ".." Then
    
        ElseIf WFD.dwFileAttributes And _
          FILE_ATTRIBUTE_DIRECTORY Then
            searchForFiles fPathName, match
            
        ElseIf Check1.Value = vbUnchecked Then
            'Match any protion of the filename found
            '  because the checkbox is unchecked
            If InStr(fName, match) Then
                AddAnItem fPathName
            Else
                DoEvents
            End If
            
        ElseIf matchLen > nameLen Then
            'Don't do anything if found is too short
            
        ElseIf LCase$(Right$(fName, matchLen)) _
          = match Then
            'We have an extension match
            AddAnItem fPathName
        Else
            DoEvents
        End If
        
        'Subsequent API calls are to FindNextFile.
        found = FindNextFile(hfind, WFD)
    Loop
    
    'Then close the findfile operation
    FindClose hfind
End Sub

'Add an item to the listbox
Private Sub AddAnItem(f$)
    Num = Num + 1
    List1.AddItem f
    Label1.Caption = Str$(Num) & " Files"
    DoEvents
    
    'Keep track of the longest name for the
    '  eventual horizontal scrollbar
    If TextWidth(f) > maxWdth Then
        maxWdth = TextWidth(f)
    End If
End Sub

'The Find API's return strings terminated by the null
'  character, Chr$(0). We must find that char and
'  return the portion to the left that VB can use.
Private Function TrimNull$(ByVal Item As String)
    Dim pos As Integer
    
    pos = InStr(Item, Chr$(0))
    If pos = 1 Then
        Item = ""
    ElseIf pos > 1 Then
        Item = Left$(Item, pos - 1)
    End If
    
    TrimNull = Item
End Function

Private Sub Form_Load()
    Move 1000, 1000, 3840, 5880
    
    'NOTE: Combo1 height is read only at runtime
    '      please set it to 315 in properties window
    Combo1.Move 2040, 2400, 1575
    List1.Move 120, 3360, 3495, 2010
    
    With Command1
        .Move 240, 2400, 1575, 315
        .Caption = "Search"
    End With
    
    With Check1
        .Move 240, 2880, 1575, 255
        .Caption = "Extensions"
        .Value = vbChecked
    End With
    
    With Dir1
        .Move 120, 120, 3495, 2115
        .Path = "C:\"
    End With
    
    With Label1
        .Move 2040, 2920, 1575, 255
        .Caption = "0 Files"
    End With
    
    
    With Combo1
        'You can add more file types here
        .AddItem "mp3"
        .AddItem "jpg"
        .AddItem "gif"
        .AddItem "txt"
        .AddItem "htm"
        .AddItem "exe"
        
        'Adjust the default extension if you want
        .Text = .List(0)
    End With
End Sub