Using VBA To Search For Specified File in all directories

Option Explicit

List all drives in ur system

sub drives()

for each dr in createobject("scripting.filesystemobject").drives

FileFindFirst(dr.driveletter+":\",filename)

End SubTo find a file in a drive

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)

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)

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

sTestFile = Dir$

Loop

If Len(sResString) Then

'Found next matching file

Exit For

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

ExitFunction:

End Function

'Demonstration Routine

Sub Test()

Dim sFile As String

'Find all instances of SCRRUN.DLL

Debug.Print "Search for SCRRUN.DLL----------"

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----------"

sFile = FileFindFirst("C:\", "*.bas")

If Len(sFile) Then

Debug.Print sFile

Else

Debug.Print "--------END OF SEARCH"

Exit Do

End If

Loop

End Sub

2 Replies

Know the answer? Post it — somebody with the same question will find it here.

Pavi S14y ago
i need to check file "abc.txt" in all the directories, if "c:" does not cotain the file i need to search another directory recursevly and have to return the file path
Santhosh Kumar Jayaraman14y ago
Option Explicit
List all drives in ur system

sub drives()
for each dr in createobject("scripting.filesystemobject").drives
  FileFindFirst(dr.driveletter+":\",filename)
Next
End SubTo find a file in a drive

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