SQL Update Not working

[CN3capt]

Have a system with 3 tables (tblCaseMain, tblItems, tbleItemsTemp). The tblItems is related to the tblCaseMain by CaseID so each case file can contain many Items. The temp table is used as a holder for items until saved. As items are received they can be either Accepted or Rejected which is a field in the tblItems. The tblCaseMain contains numeric fields for the qty of items Accepted or Rejected. What i am trying to do after the Items have been entered and the tblItemsTemp and appended to the tblItems I want a count of how many Accepted and how many Rejected. Those values then need to be placed in the [ItemsSubmitted] and [ItemsRejected] fields in the tbleCaseMain for the CaseID which is obtained from the open Main form txtCaseID. The VBA works for the APPEND of the records and the Count seems to work but it is not working when I put it all together I get a ERROR 3061. This code is on the Save button on the TempItems form.

Option Compare Database
Option Explicit

Private Sub cmdCloseSave_Click()
On Error GoTo Err_cmdCloseSave_Click
Dim iMsg As String
Dim stDocName1 As String
Dim stDocName2 As String

stDocName1 = "qryDelTempItems"
stDocName2 = "qryAppendItems"

iMsg = "Do you wish to UPDATE Exhibit Items to this Case?"

Select Case MsgBox(iMsg, vbYesNo + vbQuestion, "Exhibit Items")

Case vbNo
'delete records from Temp table for current CaseNoID
DoCmd.SetWarnings False 'Turn messages OFF
DoCmd.OpenQuery stDocName1 'Delete items from temp table
DoCmd.SetWarnings True 'Turn messages ON
DoCmd.Close acForm, Me.Name
Case vbYes
'append records from Temp table to Item table for current CaseNoID
DoCmd.SetWarnings False 'Turn mesages OFF
DoCmd.OpenQuery stDocName2 'Append from tblItemsTemp to tblItems
DoCmd.OpenQuery stDocName1 'Delete items from TblItemsTemp
DoCmd.SetWarnings True 'Turn messages ON
Call exhibCalc
DoCmd.Close acForm, Me.Name
Forms!frmCaseMainTab.Refresh
End Select
Exit_cmdCloseSave_Click:
Exit Sub
Err_cmdCloseSave_Click:
' Handle errors
MsgBox "An unexpected error has occurred." & _
vbCrLf & "Please note of the following details then click OK:" & _
vbCrLf & "Error Number: " & Err.Number & _
vbCrLf & "Description: " & Err.Description _
, vbCritical, "Error"
Resume Exit_cmdCloseSave_Click

End Sub

Private Sub exhibCalc()
Dim strSql As String
Dim strSqlAcc As String
Dim strSqlRej As String
Dim stAccept As Long
Dim stReject As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim qdf As QueryDef
Set db = CurrentDb
strSqlAcc = "SELECT Count(1) AS [""Number Accepted""] " & vbCrLf & _
"FROM tblItems " & vbCrLf & _
"WHERE (((tblItems.ItemAcceptReject)=""Accepted"") AND ((tblItems.CaseNoID)=[Forms]![frmCaseMainTab]![txtCaseID]));"
strSqlRej = "SELECT COUNT(1) AS [""Number Rejected""] " & vbCrLf & _
"FROM tblItems " & vbCrLf & _
"WHERE (((tblItems.ItemAcceptReject)=""Rejected"") AND ((tblItems.CaseNoID)=[Forms]![frmCaseMainTab]![txtCaseID]));"
Set rs = db.OpenRecordset(strSqlAcc, dbOpenDynaset)
If rs.RecordCount > 0 Then
rs.MoveFirst
stAccept = rs.Fields(0) 'this means the first field returned, you can also use rs.fields("name") to get the same result.
Else
stAccept = 0
End If
Set rs2 = db.OpenRecordset(strSqlRej, dbOpenDynaset)
If rs2.RecordCount > 0 Then
rs2.MoveFirst
stReject = rs2.Fields(0) 'this means the first field returned, you can also use rs.fields("name") to get the same result.
Else
stReject = 0
End If
strSql = "UPDATE tblCaseMain SET tblCaseMain.ItemsRejected = & stReject &, tblCaseMain.ItemsSubmitted = & stAccept & " & vbCrLf & _
"WHERE (((tblCaseMain.CaseID)=[Forms]![frmCaseMainTab]![txtCaseID]));"
db.Execute strSql
Set rs = Nothing
Set rs2 = Nothing
Set db = Nothing
End Sub

 

[SpentGeezer]

ERROR 3061 = You need to check your SQL statements.....It is a bit hard to debug the code without the database. Can you indicate which line in the code that the error occurs?

 

[CN3capt]

Thanks Mr Geezer but after all that I found that DCount did what I wanted. stQryAcc and Rej just filter the records for that CaseID so one for Accepted and one for Rejected.

Here is the final code that works.

Private Sub cmdCloseSave_Click()
On Error GoTo Err_cmdCloseSave_Click
Dim iMsg As String
Dim stDocName1 As String
Dim stDocName2 As String
Dim stQryAcc As String
Dim stQryRej As String
Dim nAccept As Long
Dim nReject As Long

stDocName1 = "qryDelTempItems"
stDocName2 = "qryAppendItems"
stQryAcc = "qryTempItemAccepted"
stQryRej = "qryTempItemRejected"

iMsg = "Do you wish to UPDATE Exhibit Items to this Case?"

Select Case MsgBox(iMsg, vbYesNo + vbQuestion, "Exhibit Items")

Case vbNo
'delete records from Temp table for current CaseNoID
DoCmd.SetWarnings False 'Turn messages OFF
DoCmd.OpenQuery stDocName1 'Delete items from temp table
DoCmd.SetWarnings True 'Turn messages ON
DoCmd.Close acForm, Me.Name
Case vbYes
nAccept = DCount("*", stQryAcc)
'MsgBox nAccept, , "Accepted"
nReject = DCount("*", stQryRej)
'MsgBox nReject, , "Rejected"
Forms!frmCaseMainTab.txtItemsAccepted.Value = nAccept
Forms!frmCaseMainTab.txtItemsRejected.Value = nReject
'append records from Temp table to Item table for current CaseNoID
DoCmd.SetWarnings False 'Turn mesages OFF
DoCmd.OpenQuery stDocName2 'Append from tblItemsTemp to tblItems
DoCmd.OpenQuery stDocName1 'Delete items from TblItemsTemp
DoCmd.SetWarnings True 'Turn messages ON
DoCmd.Close acForm, Me.Name
Forms!frmCaseMainTab.Refresh
End Select

Exit_cmdCloseSave_Click:
Exit Sub
Err_cmdCloseSave_Click:
' Handle errors
MsgBox "An unexpected error has occurred." & _
vbCrLf & "Please note of the following details then click OK:" & _
vbCrLf & "Error Number: " & Err.Number & _
vbCrLf & "Description: " & Err.Description _
, vbCritical, "Error"
Resume Exit_cmdCloseSave_Click

End Sub

 

[jdraw]

I think there is a syntax error in this

strSql = "UPDATE tblCaseMain SET tblCaseMain.ItemsRejected = & stReject &, tblCaseMain.ItemsSubmitted = & stAccept & " & vbCrLf & _
"WHERE (((tblCaseMain.CaseID)=[Forms]![frmCaseMainTab]![txtCaseID]));"

and suggest you insert some debug.print statements to show the
strSQL value in the immediate window to help track down your error.

 

[boblarson]

In the future please use CODE TAGS when posting code to make it more easily read.