Hello and welcome to our community! Is this your first visit?
Register
Enjoy an ad free experience by logging in. Not a member yet? Register.
Results 1 to 2 of 2
  1. #1
    New to the CF scene
    Join Date
    May 2012
    Location
    Toronto
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts

    search field criteria in every ms access objects

    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

  • #2
    New to the CF scene
    Join Date
    May 2012
    Location
    Toronto
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts
    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


  •  

    Tags for this Thread

    Posting Permissions

    • You may not post new threads
    • You may not post replies
    • You may not post attachments
    • You may not edit your posts
    •