I found this code on the web to search your hard drive for files. The code returns the path and file name.
I’m trying to populate a table with the results for a design feature later. I added a function “Populate” that
I thought would fill in the table(tblLocations). When the code gets to the OpenRecordset line it jumps back to
a line in the “Function FindSubFolders(folderspec)” function. I can’t figure out why.
Call FileSearch to run and replace the “Training.mdb” with a file name on your hard drive.
The results print in the debug window.
Here is the code:
Function FileSearch()
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
'On Error Resume Next
Dim d, dc, s
Set dc = fso.Drives
For Each d In dc
If d.DriveType = 2 Then 'Or d.DriveType = 3 Then '2= Local 3 = Network
Call FindSubFolders(d.Path & "") 'Find Folders in Drive
End If
Next
End Function
Function FindSubFolders(folderspec)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Dim f, f1, sf
Set f = fso.GetFolder(folderspec)
Set sf = f.SubFolders 'Find sub folders
For Each f1 In sf
DoEvents
Call FindFiles(f1.Path) 'find files in dir
Call FindSubFolders(f1.Path) 'Recall to get the sub folders 'Jumps back to here
Next
End Function
Function FindFiles(folderspec)
Dim fso, fc, f, s
Dim file1 As String
Dim f1
Dim strField1 As String
Dim strField2 As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
file1 = "training.mdb" ' file you are looking to find on the hard drive.
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc
s = fso.GetFileName(f1.Path)
DoEvents
If s = file1 Then
Debug.Print f1.Path
strField1 = file1
strField2 = f1.Path
Call Populate(strField1, strField2)
End If
Next
End Function
Function Populate(strField1 As String, strField2)
Dim db As Database
Dim rs As Recordset
Dim strSql As String
Set db = CurrentDb
strSql = "Select tblLocations.* FROM tblLocations"
Set rs = db.OpenRecordset(strSql, dbOpenDynaset)
rs.AddNew
rs!Database = strField1
rs!Path = strField2
rs.Update
rs.Close
Set rs = Nothing
End Function
