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
E!