VB and VBA Users Source Code: Find a File on a Drive/Directory
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Find a File on a Drive/Directory
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, January 08, 2001
Hits:
1100
Category:
Files/Directories/IO
Article:
To search a directory or drive for a specified file or pattern use the following routine. Note, a test routine can be found at the bottom of the post. Option Explicit 'Purpose : Performs a recursive search starting from the specified directory ' to find the next matching file (uses the file scripting object) 'Inputs : sInitialDirectory The directory to begin the seach from ' sFilePattern The file pattern to seach for eg. "*.xls" 'Outputs : Returns the full path and name of the next matching file 'Author : Andrew Baker 'Date : 08/01/2001 20:24 'Notes : Can be called recursively to find all instances of the specified file pattern ' Requires a Reference to SCRRUN.DLL ("Microsoft Scripting Runtime") 'Revisions : Function FileFindFirst(ByVal sInitialDirectory As String, ByVal sFilePattern As String) As String Static FSO As Scripting.FileSystemObject, oDirectory As Scripting.Folder, oThisDir As Scripting.Folder Static ssLastPattern As String, ssLastFiles As String Dim sThisPath As String, sResString As String, sTestFile As String If (FSO Is Nothing) = True Then Set FSO = New Scripting.FileSystemObject End If If Right$(sInitialDirectory, 1) <> "\" Then sInitialDirectory = sInitialDirectory & "\" End If 'Seach current directory sThisPath = sInitialDirectory sTestFile = Dir$(sThisPath & sFilePattern) Do If FileExists(sThisPath & sTestFile) Then If InStr(1, ssLastFiles, "|" & sThisPath & sTestFile) = 0 Then 'Found next matching file sResString = sThisPath & sTestFile Exit Do End If Else 'No more matching files in this directory Exit Do End If 'Get next matching file sTestFile = Dir$ Loop If Len(sResString) = 0 Then 'File not found in sInitialDirectory, search sub directories... Set oDirectory = FSO.GetFolder(sInitialDirectory) For Each oThisDir In oDirectory.SubFolders sThisPath = oThisDir.Path If Right$(sThisPath, 1) <> "\" Then sThisPath = sThisPath & "\" End If sTestFile = Dir$(sThisPath & sFilePattern) Do If FileExists(sTestFile) Then If InStr(1, ssLastFiles, "|" & sThisPath & sTestFile) = 0 Then 'Found next matching file sResString = sInitialDirectory & sTestFile End If Else 'No more matching files in this directory, check it's subfolders sTestFile = FileFindFirst(sThisPath, sFilePattern) If FileExists(sTestFile) Then If InStr(1, ssLastFiles, "|" & sThisPath & sTestFile) = 0 Then 'Found next matching file sResString = sTestFile Exit Do End If Else 'File not found in sub folder Exit Do End If End If sTestFile = Dir$ Loop If Len(sResString) Then 'Found next matching file Exit For End If Next End If If Len(sResString) Then 'Store search parameters If sFilePattern = ssLastPattern Then 'Routine has been called with same parameters, store all previously matching files ssLastFiles = ssLastFiles & "|" & sResString Else 'Store matching file ssLastFiles = "|" & sResString End If ssLastPattern = sFilePattern 'Return result FileFindFirst = sResString End If End Function 'Purpose : Checks if a file exists 'Inputs : sFilePathName The path and file name e.g. "C:\Autoexec.bat" 'Outputs : Returns True if the file exists 'Author : Andrew Baker 'Date : 25/11/2000 03:33 'Notes : 'Revisions : Function FileExists(sFilePathName As String) As Boolean On Error GoTo ExitFunction If Len(sFilePathName) Then If (GetAttr(sFilePathName) And vbDirectory) < 1 Then 'File Exists FileExists = True End If End If ExitFunction: End Function 'Demonstration Routine Sub Test() Dim sFile As String 'Find all instances of SCRRUN.DLL Debug.Print "Search for SCRRUN.DLL----------" Do sFile = FileFindFirst("C:", "SCRRUN.DLL") If Len(sFile) Then Debug.Print sFile Else Debug.Print "--------END OF SEARCH" Exit Do End If Loop 'Find all the "bas" files on the c drive Debug.Print "Search for *.bas----------" Do sFile = FileFindFirst("C:\", "*.bas") If Len(sFile) Then Debug.Print sFile Else Debug.Print "--------END OF SEARCH" Exit Do End If Loop End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
