troubleshooting Question

VBA: DoCmd.OpenQuery failure after creating a new query

Avatar of VBProEd
VBProEd asked on
Microsoft Access
2 Comments1 Solution537 ViewsLast Modified:
Hey there boys and girls:

I have an interesting quirk when building queries in Access.  Don't fret over the code as it works perfectly.  My problem is if I uncomment the DoCmd.OpenQuery strQueryName, acViewNormal, acEdit, it either opens the new query created or it aborts telling me that it cannot find the query in the collection.  Never mind that I refresh the views and tables before the DoCmd.  Any clues as to why it fails sometimes and not others?  Is there another internal Access function available to update an index or something??

E!

Public Function BuildQueryType(strFieldError As String, strTableSelected As String)
    Const conQueryAlreadyExists As Integer = 3012
    Const conQueryDeleted As Integer = 3167
    Dim objDatabase             As DAO.Database
    Dim objCatalog              As ADOX.Catalog
    Dim objQueryDef             As DAO.QueryDef
    Dim strSQLQuery             As String
    Dim strQueryName            As String
    Dim strQueryDescription     As String
    Dim intTextTruncation       As Integer
   
    On Error GoTo BuildQueryType_Err
   
    Set objCatalog = New ADOX.Catalog
    Set objDatabase = OpenDatabase(CurrentProject.FullName)
    strQueryName = RTrim("Qry " & strTableSelected & " w/Err_Fld = " & strFieldError)
    If Len(Trim(strQueryName)) > 65 Then
        intTextTruncation = Len(Trim(strQueryName)) - 65
        strQueryName = Mid(strQueryName, 1, Len(Trim(strQueryName)) - intTextTruncation)
    End If
    If Len(Trim(strFieldError)) = 0 Or _
       Len(Trim(strTableSelected)) = 0 Then
        MsgBox "Select a Table and Field Error value from the drop down list.", vbOKOnly + vbExclamation, CurrentProject.Name & ": BuildQueryType Function "
    Else
        strSQLQuery = "SELECT " & strTableSelected & ".Wkr_ID, Case_Serial(" & strTableSelected & ".Case_Num) AS Case_Serial, "
        strSQLQuery = strSQLQuery & "FBU(" & strTableSelected & ".Case_Num) AS FBU, Mult(" & strTableSelected & ".Case_Num) AS Mult, "
        strSQLQuery = strSQLQuery & strTableSelected & ".Case_Stat, " & strTableSelected & ".Pers_Num, " & strTableSelected & ".CIN, "
        strSQLQuery = strSQLQuery & strTableSelected & ".Last_Name, " & strTableSelected & ".First_Name, "
        strSQLQuery = strSQLQuery & strTableSelected & ".Err_Code, " & strTableSelected & ".Err_Fld, "
        strSQLQuery = strSQLQuery & strTableSelected & ".Rec_Desc, " & "MatchFldErrToScreenNames(" & strTableSelected & ".Sys_ID, " & strTableSelected & ".Err_Fld) AS Screen_Name, "
        strSQLQuery = strSQLQuery & strTableSelected & ".Err_Desc, "
        strSQLQuery = strSQLQuery & strTableSelected & ".Err_Val, " & strTableSelected & ".Err_Cor_Val, " & strTableSelected & ".Online_Corr_Ind, "
        strSQLQuery = strSQLQuery & strTableSelected & ".Smart_Wkr_ID, " & strTableSelected & ".Smart_ID, " & strTableSelected & ".Smart_SSN FROM " & strTableSelected & " WHERE (((" & strTableSelected & ".Err_Fld)= '" & strFieldError & "'));"
        With objDatabase
            Set objQueryDef = .CreateQueryDef(strQueryName, strSQLQuery)
            .Close
        End With
    '   Update the Query Description
        strQueryDescription = "Show all rows in the " & strTableSelected & " where the error field =  '" & strFieldError & "'"
        Set objDatabase = OpenDatabase(CurrentProject.FullName)
        Set objQueryDef = objDatabase.QueryDefs(strQueryName)
        SetFieldProperty objQueryDef, "Description", dbText, strQueryDescription

        objCatalog.Tables.Refresh
        objCatalog.Views.Refresh
        CurrentProject.Application.RefreshDatabaseWindow
        DoCmd.Close acForm, "frmQuerySelection", acSaveNo
    '   This commented code works sometimes and not others.  Gets an error that it cannot find the new query
    '   even though it exists in the database collection.
    '    DoCmd.OpenQuery strQueryName, acViewNormal, acEdit
    End If
   
BuildQueryType_Exit:
    Set objDatabase = Nothing
    Set objCatalog = Nothing
    Set objQueryDef = Nothing
    Exit Function

BuildQueryType_Err:
    If Err = conQueryAlreadyExists Then
        Err.Clear
        With objDatabase
             .QueryDefs.Delete strQueryName
        End With
        If Err = conQueryDeleted Then
            Err.Clear
        End If
        Resume
    ElseIf Err = conQueryDeleted Then
            Err.Clear
            Resume
        Else
            MsgBox CStr(Err) & " " & Err.Description, , CurrentProject.Name & ": BuildQueryType procedure"
            Resume BuildQueryType_Exit
        End If
End Function

ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 1 Answer and 2 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 2 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros