Hello Experts,
This problem is driving me nuts and I would appreciate any help you can provide. I created a form for my application that consists of a main form and 2 continuous subforms, each of which contains a subform control on the main form. Everything works perfectly, except for the ticking of checkboxes on the second continuous subform, which will be discussed in detail below.
The purpose of the form is to enable the user to do bulk changes to any of several report classifications defined in the Chart of Accounts. The form works like this: The user selects via combo boxes on the main form, a report that has the accounts with the line item classification that they want to change. The first continuous subform returns a list of all the accounts and amounts from the report that has the line item selected. The second continuous form repeats the list of accounts, but has checkboxes for the user to designate which accounts are to have their classification changed, and has a combo box with a selection list for the new classification.
Everything works fine until I try to tick or untick a checkbox. I get an error message Error 3061
..Too few parameters
2 expected.
.on the line :
Set qD = dBs.CreateQueryDef("TempQr
y2")
This does not make sense because the querydef generates the query perfectly.
In fact, if I go to the query window and open the query (TempQry2), it shows that one checkbox has been ticked. Help!!!
Here is my code:
Private Sub Ckbox_AfterUpdate()
On Error GoTo Error_Routine
If Me.Dirty Then
Me.Dirty = False
End If
If strBtnFlag = "SelectAll" Then
Dim strSQLSF3 As String
strSQLSF3 = "Update [tblChartOfAccts] SET [tblChartOfAccts].[fldChar
tBlockUpdF
lag]= True"
strSQLSF3 = strSQLSF3 & " WHERE [tblChartOfAccts].[fldChar
tBlockUpdF
lag] = False" & ";"
CurrentDb.Execute strSQLSF3, dbFailOnError
Me.Refresh
ElseIf strBtnFlag = "Deselect" Then
Dim strSQLSF4 As String
strSQLSF4 = "Update [tblChartOfAccts] SET [tblChartOfAccts].[fldChar
tBlockUpdF
lag]= False"
strSQLSF4 = strSQLSF4 & " WHERE [tblChartOfAccts].[fldChar
tBlockUpdF
lag] = True" & ";"
CurrentDb.Execute strSQLSF4, dbFailOnError
Me.Refresh
Else 'If strBtnFlag = "ItemSelected" Then
Dim qD As DAO.QueryDef
Dim rst As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim iRecCount As Integer 'record count
Dim intReturn As Integer 'return from message box
Dim ctrl As Control, bytCount As Byte 'count of checkboxes ticked
Dim strFilter As String
'open recordset to handle combo box processing
Set dBs = CurrentDb()
'erase querydefs if it exists
DeleteTempQuery ("TempQry2")
strSearch = "Select varAcctCode From TempQry"
strReplace = CStr("Select " & varAcctCode & " From " & "TempQry")
strSQLSF2 = Replace(CStr(strSQLSF2), CStr(strSearch), CStr(strReplace))
Set qD = dBs.CreateQueryDef("TempQr
y2")
qD.SQL = strSQLSF2
'Create a new Recordset based on the stored QueryDef from the Query .
Set rst = qD.OpenRecordset
'filter recordset by checkboxes ticked
rst.Filter = "Me!Ckbox = True"
rst.Sort = varAcctCode2
'open a new recordset to receive filtered result set
Set rst2 = rst.OpenRecordset
iRecCount = rst2.RecordCount
bytCount = 0 'initialize counter for checkboxes ticked
If Not (rst2.BOF Or rst2.EOF) Then
With rst2
rst2.MoveLast
rst2.MoveFirst
Do Until rst2.EOF
If Me.Ckbox = -1 And iOldBoundColumnValue = iNewBoundColumnValue Then
' On Error Resume Next
bytCount = bytCount + 1
MsgBox "You haven't selected the new classification from any combo box."
Exit Do
End If
If Me.Ckbox = -1 And iOldBoundColumnValue <> iNewBoundColumnValue Then
'MsgBox "Test#1 sub2 " & iOldBoundColumnValue
'MsgBox "Test#1 sub2 " & iNewBoundColumnValue
'change all rows that have been checked to new value of the BoundColumn
rst2.Edit
With cboAcctClass
'Retrieves the value of the variable containing bound column, which may be hidden (0 width) in the listbox
rst2.Fields(CStr(varAcctCl
ass)).Valu
e = iNewBoundColumnValue
End With
rst2.Update
Me.Refresh
If iRecCount >= 1 Then
rst2.MoveNext
iRecCount = iRecCount - 1
Else
Exit Do
End If
End If
Loop
End With
End If
rst.Close
rst2.Close
End If
Exit_Continue:
'clean up
Set qD = Nothing
Set rst = Nothing
Set rst2 = Nothing
Set strSQLSFz = Nothing
strSQLSF5 = Empty
iRecCount = 0
iOldBoundColumnValue = 0
iNewBoundColumnValue = 0
sNewBoundColumnDescr = Empty
' intReturn = 0
strBtnFlag = Empty
Error_Routine:
MsgBox "Error# " & Err.Number & " " & Err.Description
Resume Exit_Continue
End Sub
Start Free Trial