Avatar of VBProEd
VBProEd
 asked on

VBA: DoCmd.OpenQuery failure after creating a new query

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

Microsoft Access

Avatar of undefined
Last Comment
VBProEd

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
shanesuebsahakarn

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
VBProEd

ASKER
Yes, that was the trick!  Thanks.
E!
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy