VB projects - Recursive file search by extension

Description: recursively search selected directory and all its sub-directories for files with specified extension
Minimum requirements: VB6
Download: source code
Screenshot:
VB projects - Recursive file search by extension

Project: EXE
Controls: DriveListBox Drive1, TextBox txtExt, CommandButton cmdGet (Caption = "Get"), TextBox txtOut (MultiLine = -1 'True, ScrollBars = 3 'Both), Label Label1 (Caption = "Extension: ")
Additional references: Microsoft Scripting Runtime
Code:

Option Explicit

Dim fso As New FileSystemObject
Dim fld As Folder

Private Sub cmdGet_Click()
  Me.MousePointer = vbHourglass
  cmdGet.Enabled = False
  txtExt.Enabled = False
  txtOut = ""
  FindFile Dir1.Path, txtExt
  txtOut = txtOut & vbCrLf & "Search complete"
  txtOut.SelStart = Len(txtOut)
  cmdGet.Enabled = True
  txtExt.Enabled = True
  Me.MousePointer = vbDefault
End Sub

Private Function FindFile(ByVal sFol As String, sFile As String) As Long
  Dim tFld As Folder, tFil As File, FileName As String

  Set fld = fso.GetFolder(sFol)
  For Each tFil In fld.Files
    If Mid(tFil.Name, InStrRev(tFil.Name, ".") + 1) = txtExt Then _
      txtOut = txtOut & fso.BuildPath(fld.Path, tFil.Name) & vbCrLf
      txtOut.SelStart = Len(txtOut)
    DoEvents
  Next
  
  If fld.SubFolders.Count > 0 Then
    For Each tFld In fld.SubFolders
      DoEvents
      FindFile = FindFile + FindFile(tFld.Path, sFile)
    Next
  End If
End Function

Private Sub Drive1_Change()
  Dim sDir As String
  
  sDir = Drive1.Drive
  If InStr(sDir, "\\") <> 0 Then
    sDir = Trim(Mid(sDir, InStr(sDir, "\\")))
    If InStr(sDir, "]") <> 0 Then sDir = Left(sDir, InStr(sDir, "]") - 1)
  ElseIf InStr(sDir, "[") <> 0 Then
    sDir = Trim(Left(sDir, InStr(sDir, "[") - 1))
  End If
  If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
  Dir1.Path = sDir
End Sub

Private Sub Form_Load()
  Drive1_Change
End Sub

Private Sub Form_Unload(Cancel As Integer)
  End
End Sub