search field criteria in every ms access objects

[tonycuban]

has any one developed a function or other method that looks into every query and report of the database and if a specific field has criteria, returns the name of the query or report.

example:
i want to know which queries in my database has criteria in field "ACCOUNT" and returns their names

query_01 = SELECT Level.* FROM [Level] WHERE (((Level.ACCOUNT)="12"));

query_02 = SELECT Level.* FROM [Level] WHERE (((Level.Key)="ABC"));

query_03 = SELECT Level.* FROM [Level] WHERE (((Level.ACCOUNT)="21"));

the function should return only query_01 and query_03

[tonycuban]

i did my own code since i got not inmediate reply.
if you need the solution:

1- create a table named HoldSQL with 3 fields

field Name: queryName
data type: Text
Field Size: 255

field Name: strSelect
data type: Memo

Field Name: strWhere
data type: Memo

2- create a macro that runcode find_SQL()
after the next step run this macro

3- create a module and paste the following code (remember to do a Replace and change all CHANGE_ME to the name of the field you want to check for)

Option Compare Database
Option Explicit

Function find_SQL()
Dim db As Database, dbPathName As String, dbName As String, strSQL As String, qryName As String, dbType As String
Dim rstQuery As Recordset
Dim qdfSource As QueryDef, rstSQL As Recordset, intChr As Integer, intStr As Integer

dbPathName = OpenFileDialog

dbType = Right(dbPathName, 3)

If dbType <> "mdb" And dbType <> "mwa" Then
MsgBox "You have selected a file other than a MS Access database", vbOKOnly, "Non MS Access database"
Exit Function
End If

intChr = findPosition(dbPathName, "\")

strSQL = "SELECT MSysObjects.Name FROM MSysObjects IN '" & dbPathName & "' WHERE (((MSysObjects.Type)=5));"

dbName = Mid(dbPathName, intChr + 1, Len(dbPathName))
dbName = Left(dbName, Len(dbName) - 4)

If TableExists(dbName) Then DoCmd.DeleteObject acTable, dbName

CurrentDb.Execute "DELETE HoldSQL.* FROM HoldSQL;"
DoCmd.CopyObject , dbName, acTable, "HoldSQL"

Set rstQuery = CurrentDb.OpenRecordset(strSQL)

If rstQuery.EOF = True Then
MsgBox dbName & " contains no queries", vbOKOnly, "No Queries"
Set rstQuery = Nothing
Exit Function
End If

Set rstSQL = CurrentDb.OpenRecordset(dbName)

Set db = DBEngine.Workspaces(0).OpenDatabase(dbPathName)

rstQuery.MoveFirst
Do While rstQuery.EOF = False
qryName = rstQuery!Name
Set qdfSource = db.QueryDefs(qryName)

strSQL = qdfSource.SQL
intChr = findPosition(strSQL, "CHANGE_ME)")
intStr = findPosition(strSQL, "CHANGE_ME]")

If intChr > 0 Or intStr > 0 Then
intChr = findPosition(strSQL, "WHERE")
rstSQL.AddNew
rstSQL!queryname = qryName
If intChr > 0 Then rstSQL!strWhere = Mid(strSQL, intChr, Len(strSQL) - intChr)
If intStr > 0 Then rstSQL!strSelect = Left(strSQL, Len(strSQL) - intChr)
rstSQL.Update
End If
rstQuery.MoveNext
Loop

DoCmd.OpenTable dbName

Set db = Nothing
Set rstSQL = Nothing
Set rstQuery = Nothing
End Function

Function findPosition(dbName As String, str2Search As String) As Integer
Dim Position As Integer, holdPosition As Integer

Position = 0
Do
holdPosition = Position
Position = InStr(Position + 1, dbName, str2Search)
Loop Until Position = 0

findPosition = holdPosition
End Function

Public Function OpenFileDialog() As Variant
Dim FileDialog As FileDialog
Dim vFileSelected As Variant, X As Integer

Set FileDialog = Application.FileDialog(msoFileDialogOpen)
If FileDialog.Show = -1 Then
For Each vFileSelected In FileDialog.SelectedItems
OpenFileDialog = OpenFileDialog & ";" & vFileSelected
X = X + 1
Next vFileSelected
Else
MsgBox "No File has been selected"
End If

Set FileDialog = Nothing
OpenFileDialog = Mid(OpenFileDialog, 2)

End Function

Function TableExists(TableName As String) As Boolean
Dim strTableNameCheck
On Error GoTo ErrorCode

strTableNameCheck = CurrentDb.TableDefs(TableName)

TableExists = True

ExitCode:
On Error Resume Next
Exit Function

ErrorCode:
Select Case Err.Number
Case 3265
TableExists = False
Resume ExitCode
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
Resume ExitCode
End Select

End Function