Attribute VB_Name = "modFindFile_FSO" Option Explicit '============================================================================================================= ' ' modFindFile_FSO Module ' ---------------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Last Update : October 12, 2000 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : SCRRUN.DLL (Microsoft Scripting Runtime) - FileSystemObject ' ' Description : This module was created to make it easy to search for a specified file, or type of file in a ' specified folder, or on a specified drive or drives. This module allows you several search ' options as well to make the searching process as customizable as possible. ' ' This module also has functionity that allows you to easily tell if a specified file, folder, ' or drive exists on the user's computer. ' ' See Also : modFindFile_API (Same as this module, but uses the Win32 API) ' ' Example Use : (This example will search the C:\ drive for all copies of the file ' "Kernel32.dll" and will put the results of the find in Text1 & 2) ' ' Dim Paths As String ' Dim nFound As Long ' ' If FF_FindFile("Kernel32.dll", Paths, nFound, "WholeDrive", _ ' False, C, False, True, False) = True Then ' Text1.Text = Paths ' Text2.Text = CStr(nFound) & " Matching Files Found" ' End If ' ' (See Also - FF_SearchCallback) ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= Public Enum DriveLetters a = 65 B = 66 c = 67 d E F G H I J k L M n O P Q r s T U v W X Y Z [Unknown] End Enum '--------------------------------------------------------------------------------- ' * IMPORTANT - Set this global variable to TRUE to abort a search '--------------------------------------------------------------------------------- Public FF_CancelSearch As Boolean '--------------------------------------------------------------------------------- '--------------------------------------------------------------------------------- ' FF_FindFile ' ' Purpose: ' Function that searches the specified folder, drive, or drives for a specified ' file. This function can also search for all files containing the specified ' string by setting the WildCardSearch parameter to true. ' ' Perameter: Use: ' --------------------------------------- ' FileName Specifies the file to search for. ' If the WildCardSearch is set to TRUE, files that contain ' this value somewhere in them are returned as a match. ' Return_Paths Returns the file path(s) of matching files seperated ' by a CRLF (vbCrLf). ' Return_nFound Returns the number of matches found. ' SearchPath Optional. If this value is specified, this function ' searches just the specified path for the file ' SearchAllDrives Optional. If this is set to TRUE, and the SearchPath ' parameter is not set, then all valid drives are searched. ' DriveToSearch Optional. If the SearchPath is not specified, and the ' SearchAllDrives parameter is FALSE, then this specifies ' which drive to search. ' WildCardSearch Optional. If this is set to FALSE, only exactly matching ' files will match the specified search file. If this is ' set to TRUE, all files containing the text in the ' FileName paremter will match. ' SearchSubfolders Optional. If this is set to TRUE, subfolders will be ' searched for matching files. ' StopSearchingWhenFound Optional. If this is set to TRUE, the search will stop ' once a matching file is found. ' SearchRemoveableDrives Optional. This parameter only applies of the ' SearchAllDrives parameter is set to TRUE and the ' SearchPath parameter is not specified. If set to FALSE, ' removable drives like Floppy drives and ZIP drives will ' not be searched. ' SearchRemoteDrives Optional. This parameter only applies if the ' SearchAllDrives parameter is set to TRUE and the ' SearchPath parameter is not specified. If set to FALSE, ' Network drives that are currently mapped will not be ' searched. ' ' Return: ' Returns TRUE if the search succeeded. ' Returns FALSE if the search failed. ' '--------------------------------------------------------------------------------- Public Function FF_FindFile(ByVal FileName As String, _ ByRef Return_Path As String, _ ByRef Return_nFound As Long, _ Optional ByVal SearchPath As String = "WholeDrive", _ Optional ByVal SearchAllDrives As Boolean = False, _ Optional ByVal DriveToSearch As DriveLetters = c, _ Optional ByVal WildCardSearch As Boolean = False, _ Optional ByVal SearchSubfolders As Boolean = True, _ Optional ByVal StopSearchingWhenFound As Boolean = False, _ Optional ByVal SearchRemoveableDrives As Boolean = False, _ Optional ByVal SearchRemoteDrives As Boolean = False) As Boolean On Error GoTo ErrorTrap Dim FSO As FileSystemObject Dim DriveTemp As Drive Dim Drive() As Drive Dim DriveCount As Long Dim MyCounter As Long Dim FolderTemp As Folder Dim ExitAfter As Boolean ' Clear the return variables to start fresh Return_Path = "" Return_nFound = 0 ' Make sure the file path specified is valid If Trim(FileName) = "" Then Exit Function End If ' Create the file system object to work with Set FSO = New FileSystemObject ' Set a public variable to tell what's being searched FF_CancelSearch = False ' Search the whole drive If SearchPath = "" Or UCase(SearchPath) = "WHOLEDRIVE" Then ' Make sure the specified drive is valid If CLng(DriveToSearch) < 65 Then MsgBox "Specified drive to search is invalid.", vbOKOnly + vbExclamation, " Invalid Drive Letter" GoTo FailOut ElseIf CLng(DriveToSearch) > 90 Then MsgBox "Specfied drive to search is invalid. You can only search one drive at a time. To search multiple drives, call the FindFile function multiple times with different drive letters. If the drive doesn't exist, no error occurs... instead the return is false.", vbOKOnly + vbExclamation, " Invalid Drive Specified" GoTo FailOut End If ' Just search a specified folder Else If FSO.FolderExists(SearchPath) = False Then MsgBox SearchPath & Chr(13) & Chr(13) & "The specified folder to start searching in was not found.", vbOKOnly + vbExclamation, " Folder Not Found" GoTo FailOut End If ' Search the drive and all it's subfolders for the specified file If WildCardSearch = False Then Return_Path = Return_Path & FindFileInFolder(FileName, FSO.GetFolder(SearchPath), StopSearchingWhenFound, SearchSubfolders, Return_nFound) Else Return_Path = Return_Path & FindFileInFolder_WildCard(FileName, FSO.GetFolder(SearchPath), StopSearchingWhenFound, SearchSubfolders, Return_nFound) End If GoTo Continue End If ' Itterate through all the drives on the current system and record them for future use For Each DriveTemp In FSO.drives DriveCount = DriveCount + 1 ReDim Preserve Drive(1 To DriveCount) As Drive Set Drive(DriveCount) = DriveTemp Next ' Check that there were drives found If DriveCount = 0 Then GoTo FailOut End If ' Just one drive specified to search For MyCounter = 1 To DriveCount ' See if the current drive is the one selected If SearchAllDrives = False Then If UCase(Drive(MyCounter).DriveLetter) = Chr(DriveToSearch) Then ExitAfter = True GoTo CheckDrive Else GoTo SkipDrive End If Else GoTo CheckDrive End If CheckDrive: ' Make sure that that the drive is one that was specified If SearchRemoteDrives = False And Drive(MyCounter).DriveType = Remote Then GoTo SkipDrive ElseIf SearchRemoveableDrives = False And Drive(MyCounter).DriveType = Removable Then GoTo SkipDrive ' Make sure the drive is ready to be checked ElseIf Drive(MyCounter).IsReady = False Then GoTo SkipDrive End If ' Search the drive and all it's subfolders for the specified file If WildCardSearch = False Then Return_Path = Return_Path & FindFileInFolder(FileName, Drive(MyCounter).RootFolder, StopSearchingWhenFound, SearchSubfolders, Return_nFound) Else Return_Path = Return_Path & FindFileInFolder_WildCard(FileName, Drive(MyCounter).RootFolder, StopSearchingWhenFound, SearchSubfolders, Return_nFound) End If SkipDrive: Next Continue: ' If the path has an extra CRLF on the end of it, trim it off If Right(Return_Path, 2) = vbCrLf Then Return_Path = Left(Return_Path, Len(Return_Path) - 2) End If If Return_Path <> "" Then FF_FindFile = True End If FailOut: ' Delete the FileSystemObject variable so it doesn't keep taking up memory when not used Set FSO = Nothing Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Unknown Error MsgBox Err.Source & " encountered the following error:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Err.Number = 0 GoTo FailOut End If End Function ' Function that checks the specified drive letter to see if it exists on the user's machine Public Function FF_DriveExists(ByVal DriveToCheck As DriveLetters) As Boolean On Error GoTo ErrorTrap Dim FSO As FileSystemObject Dim Drive As Drive ' Make sure the specified drive is valid If CLng(DriveToCheck) < 65 Then MsgBox "Specified drive to search is invalid.", vbOKOnly + vbExclamation, " Invalid Drive Letter" ElseIf CLng(DriveToCheck) > 90 Then MsgBox "Specfied drive to search is invalid. You can only search one drive at a time. To search multiple drives, call the FindFile function multiple times with different drive letters. If the drive doesn't exist, no error occurs... instead the return is false.", vbOKOnly + vbExclamation, " Invalid Drive Specified" Exit Function End If ' Create FileSystemObject Set FSO = New FileSystemObject ' Check each drive on the system to see if it matches the specified one For Each Drive In FSO.drives If Drive.DriveLetter = Chr(DriveToCheck) Then FF_DriveExists = True Exit For End If Next ' Delete the FileSystemObject Set FSO = Nothing Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Unknown Error MsgBox Err.Source & " encountered the following error:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Err.Number = 0 End If End Function ' Function that checks the specified folder to see if it exists on the user's machine Public Function FF_FolderExists(ByVal FolderPath As String) As Boolean On Error GoTo ErrorTrap Dim FSO As FileSystemObject ' Check for valid path If Trim(FolderPath) = "" Then Exit Function End If ' Create FileSystemObject Set FSO = New FileSystemObject ' Check if folder exists FF_FolderExists = FSO.FolderExists(FolderPath) ' Delete the FileSystemObject Set FSO = Nothing Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Unknown Error MsgBox Err.Source & " encountered the following error:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Err.Number = 0 End If End Function ' Function that checks the specified file to see if it exists on the user's machine Public Function FF_FileExists(ByVal FilePath As String) As Boolean On Error GoTo ErrorTrap Dim FSO As FileSystemObject ' Check for valid path If Trim(FilePath) = "" Then Exit Function End If ' Create FileSystemObject Set FSO = New FileSystemObject ' Check if file exists FF_FileExists = FSO.FileExists(FilePath) ' Delete the FileSystemObject Set FSO = Nothing Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Unknown Error MsgBox Err.Source & " encountered the following error:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Err.Number = 0 End If End Function ' Function that returns what type of drive the specified drive is (Fixed, Remote, CD-ROM, etc.) Public Function FF_DriveType(ByVal DriveToCheck As DriveLetters) As DriveTypeConst On Error GoTo ErrorTrap Dim FSO As FileSystemObject Dim Drive As Drive ' Make sure the specified drive is valid If CLng(DriveToCheck) < 65 Then MsgBox "Specified drive to search is invalid.", vbOKOnly + vbExclamation, " Invalid Drive Letter" ElseIf CLng(DriveToCheck) > 90 Then MsgBox "Specfied drive to search is invalid. You can only search one drive at a time. To search multiple drives, call the FindFile function multiple times with different drive letters. If the drive doesn't exist, no error occurs... instead the return is false.", vbOKOnly + vbExclamation, " Invalid Drive Specified" Exit Function End If ' Create FileSystemObject Set FSO = New FileSystemObject ' Check each drive on the system to see if it matches the specified one For Each Drive In FSO.drives If Drive.DriveLetter = Chr(DriveToCheck) Then FF_DriveType = Drive.DriveType Exit For End If Next ' Delete the FileSystemObject Set FSO = Nothing Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Unknown Error MsgBox Err.Source & " encountered the following error:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Err.Number = 0 End If End Function ' Function that converts a drive letter string like "C:\" into a "DriveLetters" enumeration Public Function FF_CDrive(ByVal DriveLetter As String) As DriveLetters On Error Resume Next ' Get just the first letter by taking the first non-space character of the ' string passed to this function and making it UPPER CASE DriveLetter = UCase(Left(Trim(DriveLetter), 1)) ' Check for a valid drive letter If DriveLetter = "" Then FF_CDrive = Unknown Exit Function End If ' Check which drive letter it is Select Case DriveLetter Case "A" FF_CDrive = a Case "B" FF_CDrive = B Case "C" FF_CDrive = c Case "D" FF_CDrive = d Case "E" FF_CDrive = E Case "F" FF_CDrive = F Case "G" FF_CDrive = G Case "H" FF_CDrive = H Case "I" FF_CDrive = I Case "J" FF_CDrive = J Case "K" FF_CDrive = k Case "L" FF_CDrive = L Case "M" FF_CDrive = M Case "N" FF_CDrive = n Case "O" FF_CDrive = O Case "P" FF_CDrive = P Case "Q" FF_CDrive = Q Case "R" FF_CDrive = r Case "S" FF_CDrive = s Case "T" FF_CDrive = T Case "U" FF_CDrive = U Case "V" FF_CDrive = v Case "W" FF_CDrive = W Case "X" FF_CDrive = X Case "Y" FF_CDrive = Y Case "Z" FF_CDrive = Z Case Else FF_CDrive = Unknown End Select End Function '--------------------------------------------------------------------------------- ' FF_SearchCallBack ' ' Purpose: ' Sub that is called from the "FF_FindFile" funtion to let you know what file is ' currently being checked. ' ' *CAUTION: ' Be carefull about how much code you put into this Sub because it can potentially ' get called thousands of times within a single search and that can slow the ' search down ' ' Perameter: Use: ' --------------------------------------- ' SearchFile The file being searched for ' CurrentFolder The current search folder ' CurrentFile The file currently being checked ' WildCardSearch If TRUE, the user is searching for all files containing ' the specified search. ' If FALSE, the user is looking for an EXACT match ' (Searches are NOT case sensative because the file system ' also is not case sensative) ' ' Return: ' ( NOTHING ) ' '--------------------------------------------------------------------------------- Public Sub FF_SearchCallback(ByVal SearchFile As String, ByVal CurrentFolder As String, ByVal CurrentFile As String, ByVal WildCardSearch As Boolean) '------------------------------------------------------------------------- ' * CAUTION : Be carefull about how much code you put into this Sub because it can ' potentially get called thousands of times within a single search and ' that can slow the search down '------------------------------------------------------------------------- ' ' ' Put your search display code here. For example: ' If Form1.lblFolder.Caption <> CurrentFolder Then ' Form1.lblFolder.Caption = CurrentFolder ' Form1.lblFolder.Refresh ' End If ' If Form1.lblFile.Caption <> CurrentFile Then ' Form1.lblFile.Caption = CurrentFile ' Form1.lblFile.Refresh ' End If ' ' If WildCardSearch = True Then ' If InStr(UCase(CurrentFile), UCase(SearchFile)) > 0 Then ' Form1.txtResults.Text = Form1.txtResults.Text & CurrentFolder & "\" & CurrentFile & vbCrLf ' End If ' Else ' If UCase(SearchFile) = UCase(CurrentFile) Then ' Form1.txtResults.Text = Form1.txtResults.Text & CurrentFolder & "\" & CurrentFile & vbCrLf ' End If ' End If End Sub 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX Private Function FindFileInFolder(ByVal FileName As String, ByRef TheFolder As Folder, ByVal StopSearchingWhenFound As Boolean, ByVal SearchSubfolders As Boolean, ByRef Return_nFound As Long) As String On Error Resume Next Dim FolderTemp As Folder DoEvents If FF_CancelSearch = True Then FindFileInFolder = True Exit Function End If ' Check the current folder for the file If FF_FileExists(TheFolder.Path & "\" & FileName) = True Then ' Make a call to the "FF_SearchCallback" sub to tell it what the current search item is FF_SearchCallback FileName, TheFolder.Path, FileName, False ' Increment the found information FindFileInFolder = FindFileInFolder & TheFolder.Path & "\" & FileName & vbCrLf Return_nFound = Return_nFound + 1 If StopSearchingWhenFound = True Then Exit Function DoEvents If FF_CancelSearch = True Then FindFileInFolder = True Exit Function End If Else ' Make a call to the "FF_SearchCallback" sub to tell it what the current search item is FF_SearchCallback FileName, TheFolder.Path, "*.*", False End If If SearchSubfolders = False Then Exit Function End If ' If the current folder has subfolders, check them for matching files For Each FolderTemp In TheFolder.SubFolders FindFileInFolder = FindFileInFolder & FindFileInFolder(FileName, FolderTemp, StopSearchingWhenFound, SearchSubfolders, Return_nFound) Next If StopSearchingWhenFound = True And FindFileInFolder <> "" Then Exit Function End If End Function Private Function FindFileInFolder_WildCard(ByVal FileName As String, ByRef TheFolder As Folder, ByVal StopSearchingWhenFound As Boolean, ByVal SearchSubfolders As Boolean, ByRef Return_nFound As Long) As String On Error Resume Next Dim FileTemp As file Dim FolderTemp As Folder DoEvents If FF_CancelSearch = True Then FindFileInFolder_WildCard = True Exit Function End If ' Check the current folder for files For Each FileTemp In TheFolder.Files ' Make a call to the "FF_SearchCallback" sub to tell it what the current search item is FF_SearchCallback FileName, TheFolder.Path, FileTemp.Name, True If InStr(UCase(FileTemp.Name), UCase(FileName)) > 0 Then FindFileInFolder_WildCard = FindFileInFolder_WildCard & FileTemp.Path & vbCrLf Return_nFound = Return_nFound + 1 If StopSearchingWhenFound = True Then Exit Function DoEvents If FF_CancelSearch = True Then FindFileInFolder_WildCard = True Exit Function End If End If Next If SearchSubfolders = False Then Exit Function End If ' If the current folder has subfolders, check them for matching files For Each FolderTemp In TheFolder.SubFolders FindFileInFolder_WildCard = FindFileInFolder_WildCard & FindFileInFolder_WildCard(FileName, FolderTemp, StopSearchingWhenFound, SearchSubfolders, Return_nFound) Next If StopSearchingWhenFound = True And FindFileInFolder_WildCard <> "" Then Exit Function End If End Function