Option Compare Database 
Option Explicit 
 
Sub SearchSQL() 
     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     ' Purpose:  Search for a specific string within the SQL statements of the following:
     '
     '           - Forms
     '           - Form comboboxes
     '           - Form listboxes
     '           - Reports
     '           - Report comboboxes
     '           - Report listboxes
     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Dim db As DAO.Database 
    Dim tdf As DAO.TableDef 
    Dim qdf As DAO.QueryDef 
    Dim rec As DAO.Recordset 
    Dim frm As Access.Form 
    Dim rpt As Access.Report 
    Dim obj As Access.AccessObject 
    Dim ctl As Access.Control 
    Dim strSearch As String 
    Dim blnObjClose As Boolean 
     
    Const cstrTblName As String = "ztblSQLSearch" ' SQL search table name
    Const clngCancel As Long = vbObjectError Or 777& ' custom error on cancel
     
     
    On Error GoTo ErrHandler 
    strSearch = InputBox("Enter the search string", "Search All SQL") 
     
    If LenB(strSearch) = 0 Then 
        Err.Raise clngCancel, , "No search text entered" 
    End If 
     
    DoCmd.Hourglass True 
    Application.Echo False 
    Set db = CurrentDb 
     
     ' check whether the SQL list table already exists
    If CreateListTable(db, cstrTblName) = False Then 
        Err.Raise vbObjectError + 1001, , "Search results table already exists" 
    End If 
     
    db.TableDefs.Refresh 
    Set tdf = db.TableDefs(cstrTblName) 
    Set rec = tdf.OpenRecordset(dbOpenDynaset, dbAppendOnly) 
     
     ' List all queries
     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For Each qdf In db.QueryDefs 
        If AscW(qdf.name) <> 126& Then ' exclude all temporary queries
             ' check for the search string
            If InStrB(1, UCase(qdf.SQL), UCase(strSearch), vbDatabaseCompare) Then 
                AddRecord rec, qdf.DateCreated, qdf.name, "Query", Null, qdf.SQL 
            End If 
        End If 
    Next qdf 
     
     ' List all forms
     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For Each obj In Access.CurrentProject.AllForms 
        blnObjClose = Not obj.IsLoaded ' check whether form loaded
         
        If blnObjClose Then DoCmd.OpenForm obj.name, acDesign, , , acFormReadOnly, acHidden 
         
        Set frm = Access.Forms(obj.name) 
         
         ' check for the search string
        If InStrB(UCase(frm.RecordSource), UCase(strSearch)) Then 
            AddRecord rec, obj.DateCreated, frm.name, "Form", Null, frm.RecordSource 
        End If 
         
         ' check each combobox and listbox
        For Each ctl In frm.Controls 
            Select Case ctl.ControlType 
            Case acComboBox, acListBox 
                 ' check for the search string
                If InStrB(UCase(ctl.RowSource), UCase(strSearch)) Then 
                    AddRecord rec, obj.DateCreated, frm.name, "Form", ctl.name, ctl.RowSource 
                End If 
            End Select 
        Next ctl 
         
        If blnObjClose Then DoCmd.Close acForm, frm.name, acSaveNo 
    Next obj 
     
     ' List all reports
     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For Each obj In Access.CurrentProject.AllReports 
        blnObjClose = Not obj.IsLoaded ' check whether report loaded
         
        If blnObjClose Then DoCmd.OpenReport obj.name, acDesign, , , acHidden 
         
        Set rpt = Access.Reports(obj.name) 
         
         ' check for the search string
        If InStrB(UCase(rpt.RecordSource), UCase(strSearch)) Then 
            AddRecord rec, obj.DateCreated, rpt.name, "Report", Null, rpt.RecordSource 
        End If 
         
         ' check each combobox and listbox
        For Each ctl In rpt.Controls 
            Select Case ctl.ControlType 
            Case acComboBox, acListBox 
                 ' check for the search string
                If InStrB(UCase(ctl.RowSource), UCase(strSearch)) Then 
                    AddRecord rec, obj.DateCreated, rpt.name, "Report", ctl.name, ctl.RowSource 
                End If 
            End Select 
        Next ctl 
         
        If blnObjClose Then DoCmd.Close acReport, rpt.name, acSaveNo 
    Next obj 
     
    DoCmd.OpenTable cstrTblName 
     
     
ExitHere: 
    On Error Resume Next 
    rec.Close 
    Set rec = Nothing 
    Set qdf = Nothing 
    Set tdf = Nothing 
    Set obj = Nothing 
    Set frm = Nothing 
    Set rpt = Nothing 
    Set db = Nothing 
     
    DoCmd.Hourglass False 
    Application.Echo True 
    Exit Sub 
     
     
ErrHandler: 
    Select Case Err.Number 
    Case clngCancel 
         ' no error on cancel
    Case Else 
        MsgBox Err.Description, vbCritical, "Unexpected Error (SearchSQL: " & Err.Number & ")" 
    End Select 
    Resume ExitHere 
    Resume 
End Sub 
 
Function CreateListTable(ByRef db As DAO.Database, ByVal strTable As String) As _ 
    Boolean 
     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     ' Purpose:  Create a table to hold the list
     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Dim tdfCreate As DAO.TableDef 
     
    On Error Resume Next 
    Set tdfCreate = db.TableDefs(strTable) 
    If Err.Number = 0 Then 
        If vbYes = MsgBox("There is an existing table named " & _ 
        UCase$(strTable) & "." & vbCrLf & vbCrLf & _ 
        "Did you want to clear all the data and continue?", vbQuestion + _ 
        vbYesNo + vbDefaultButton2, "Search Results Table Exists!") Then 
             
            DoCmd.DeleteObject acTable, strTable 
        Else 
            Exit Function 
        End If 
    End If 
     
    Set tdfCreate = db.CreateTableDef(strTable) 
     
    With tdfCreate 
        .Fields.Append .CreateField("DateCreated", dbDate) 
        .Fields.Append .CreateField("ObjectName", dbText) 
        .Fields.Append .CreateField("ObjectType", dbText) 
        .Fields.Append .CreateField("ControlName", dbText) 
        .Fields.Append .CreateField("SQL", dbMemo) 
    End With 
    db.TableDefs.Append tdfCreate 
     
    CreateListTable = True 
    Set tdfCreate = Nothing 
End Function 
 
Private Sub AddRecord(ByRef rec As DAO.Recordset, ByVal dtmCreate As Date, _ 
    ByVal strName As String, ByVal strType As String, _ 
    ByVal varControl As Variant, ByVal strSQL As String) 
     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     ' Purpose:  Add a record to the search table
     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    With rec 
        .AddNew 
        .Fields(0&).Value = dtmCreate 
        .Fields(1&).Value = strName 
        .Fields(2&).Value = strType 
        .Fields(3&).Value = varControl 
        .Fields(4&).Value = strSQL 
        .Update 
    End With 
End Sub