As a contractor working predominantly on databases I haven't developed, it can be a daunting task trying to find references to tables, fields or functions within a list of several hundred queries.

The following code is attached to a command button on a simple form listing all queries in the database. The record source for the form is

SELECT DateCreate, Name FROM MSysobjects WHERE Type=5 ORDER BY DateCreate DESC

There is a text box where the user enters the text to search for. The code builds a table containing the SQL string of every query, then searches for the required text, and displays those that match.

Your form also needs a procedure the set the record source back to the default.

There are off-the-shelf applications such as Speed Ferret which perform this sort of function, however some employers are too cheap to purchase them!

sub cmdFilter_Click()
    Dim db As Database
    Dim rs As Recordset
    Dim rsFilter As Recordset
    Dim tdf As TableDef
    Dim strSQL As String
    Dim strQdf As String


    On Error GoTo ErrorHandler

    If Me.txtSearchSQL = "" Then
        MsgBox "You must enter some search criteria.", _
             vbInformation, "No Search Criteria"
        Me.txtSearchSQL.SetFocus
    End If

    DoCmd.Hourglass True
    strSQL = "SELECT DateCreate, Name FROM"
    strSQL = strSQL & " MSysobjects WHERE Type = 5"
    strSQL = strSQL & " ORDER BY DateCreate DESC"

    Set db = CurrentDb()
    Set tdf = db.CreateTableDef("tblQuerySQL")

    Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)

    With tdf
        .Fields.Append .CreateField("DateCreate", dbDate)
        .Fields.Append .CreateField("Name", dbText)
        .Fields.Append .CreateField("SQL", dbMemo)
    End With

    db.TableDefs.Append tdf
    Set rsFilter = db.OpenRecordset("tblQuerySQL", _
        dbOpenDynaset)
    rs.MoveFirst

    Do Until rs.EOF
        strQdf = rs!Name

        With rsFilter
            .AddNew
                !DateCreate = rs!DateCreate
                !Name = strQdf
                !sql = db.QueryDefs(strQdf).sql
            .Update
        End With

        rs.MoveNext
    Loop

    Me.RecordSource = "SELECT * FROM tblQuerySQL"
    Me.Filter = "SQL Like '*" & Me.txtSearchSQL & "*'"
    Me.FilterOn = True


CloseFilter:
    rs.Close
    db.Close
    DoCmd.Hourglass False
    Exit Sub


ErrorHandler:
    Select Case Err.Number
        Case 3010
            db.TableDefs.Delete "tblQuerySQL"
            Err.Clear
            Resume

        Case Else
            MsgBox Err.Number & ": " & Err.Description
            Err.Clear
            GoTo CloseFilter
    End Select
End Sub

Back to Microsoft: Access Other topics FAQ Index
Back to Microsoft: Access Other topics Forum

My Archive

My FAQ Archive

Come Join Us!

Posting Guidelines

Jobs

Microsoft: Access Other topics FAQ

VBA and Custom Functions

My Archive

Join Tek-Tips® Today!

Join Tek-Tips^® Today!