Find File

'Source Code for mdlFindFile.bas or put directly into form
Dim strLocation As String
Dim blFoundItFlag As Boolean
'Different Drive Types
'0 = "Unknown"
'1 = "Removable"
'2 = "Fixed"
'3 = "Network"
'4 = "CD-ROM"
'5 = "RAM Disk"
 
Public Sub FindIt(strFileName As String)
Dim FS As FileSystemObject
Dim Drv As Drive
Dim DrvCol
Dim RootFldr As Folder
Dim strRootPath As String
Dim strFNameToPass As String
blFoundItFlag = False
strFNameToPass = UCase(strFileName) 'will speed processing passing it this way & ensure proper comparison
 Set FS = CreateObject("Scripting.FileSystemObject")
 Set DrvCol = FS.Drives
 For Each Drv In DrvCol
 If blFoundItFlag Then 'Once we found it, don't got through the rest of the drives
 Exit Sub
 Else
 strRootPath = Drv.DriveLetter & ":\"
 If Drv.IsReady Then 'Will prevent errors
 Set RootFldr = FS.GetFolder(strRootPath)
 Call CheckEm(RootFldr, strRootPath, strFNameToPass)
 End If
 End If
 Next
 
End Sub
Public Sub CheckEm(Fldr As Folder, Path As String, FName As String)
 Dim SubFldr As Folder
 Dim strPath As String
 Dim strFName As String
 
On Error GoTo ErrHandler
 strPath = Path
 strFName = FName
 For Each SubFldr In Fldr.SubFolders
 For Each Fil In SubFldr.Files
 
 strLocation = SubFldr.ParentFolder & "\" & SubFldr.Name & "\"
 DoEvents
 'Debug.Print strLocation
 If UCase(Fil.Name) = strFName Then
 strLocation = Replace(strLocation, "\\", "\") 'Some paths have 2 \\ ???
 MsgBox strLocation 'show em where it's at
 blFoundItFlag = True
 Exit Sub
 End If
 
 Next
 Call CheckEm(SubFldr, strPath, strFName) 'Little recursive action here
 Next
Exit Sub
ErrHandler:
 If MsgBox("Error: " & Err.Number & " " & Err.Description & vbCrLf & _
 "Do you want to continue?", vbYesNo) = vbYes Then
 Resume Next
 Else
 blFoundItFlag = True
 Exit Sub
 End If
End Sub