Help to replace Application.FileSearch

crrfpalau

New member
Local time
Today, 09:14
Joined
Jun 26, 2024
Messages
1
I am not a coder but have a 2003 MSAccess database that uses Visual Basic. I am trying to run a subroutine in Access 2007 and later Access versions and it hangs up. Can someone give me replacement code for With Application.FileSearch?
Specifically the section of code reads:

Private Sub btnFind_Click()
Dim i As Integer
Dim rstCollections As New Recordset, rstPictures As New Recordset
DoCmd.Hourglass True
CurrentProject.Connection.Execute "Delete from Pictures"
With Application.FileSearch
.NewSearch
.LookIn = CurrentProject.Path & "\Pictures"
.SearchSubFolders = False
.FileName = "*.*"
.FileType = msoFileTypeAllFiles

AND then goes on to the rest of the code routine.

DO you need the entire string of code? It's not that long.

THANKS
 
according to ChatGPT:
Code:
' CHATGPT
Sub RecursiveFileSearch(ByVal folderPath As String, ByVal searchPattern As String, Optional includeSubfolder As Boolean = False)
    Dim fs As Object
    Dim folder As Object
    Dim subfolder As Object
    Dim file As Object
    Dim filePath As String
    
    On Error Resume Next
    ' Create a Scripting.FileSystemObject
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    ' Get the folder object
    Set folder = fs.GetFolder(folderPath)
    
    ' Loop through files in the current folder
        For Each file In folder.Files
            ' Check if the file matches the search pattern
            If fs.FileExists(file.Path) And fs.GetFileName(file.Path) Like searchPattern Then
                Debug.Print file.Path  ' Output the file path (you can modify this to suit your needs)
            End If
        Next file
    If includeSubfolder Then
        ' Recursively call this function for each subfolder
        For Each subfolder In folder.SubFolders
            RecursiveFileSearch subfolder.Path, searchPattern
        Next subfolder
    End If
    
    ' Clean up
    Set fs = Nothing
    Set folder = Nothing
    Set subfolder = Nothing
    Set file = Nothing
End Sub

Sub TestRecursiveFileSearch()
    ' Example usage: search for all Excel files in "C:\Test" and its subfolders
    RecursiveFileSearch Environ$("Userprofile") & "\documents", "*.*", False
End Sub
 
Try amending:
Code:
Private Sub btnFind_Click()
Dim i As Integer
Dim rstCollections As New ADODB.Recordset, rstPictures As New ADODB.Recordset
'                         ^^^^^^                              ^^^^^^
' ...
 

Users who are viewing this thread

Back
Top Bottom