I had received some great help with this problem previously several weeks ago. I made great progress with his help (I COULD NOT have gotten this far without his help!), but I got stuck at an error message I could not get rid of. I had to lay this problem down for awhile to work on other projects, but now I am back at it again, with the same error message I could not figure out how to fix before.
Here is the problem:
When I select an item from my list box, I get the error message,
I am sure the fix is something small, but I am not very familiar with working with DAO. I hope someone can help me!!! Here is the code for the list box. I have made notations of what I have tried so that I would not waste time repeating the same mistakes. Thanks to anyone with a suggestion!
Here is the problem:
When I select an item from my list box, I get the error message,
Error Number 3265Error Description: Item not found in this
collection. Error source: DAO.Parameters
I am sure the fix is something small, but I am not very familiar with working with DAO. I hope someone can help me!!! Here is the code for the list box. I have made notations of what I have tried so that I would not waste time repeating the same mistakes. Thanks to anyone with a suggestion!
Code:
Private Sub cboAnswerID_Click()
On Error GoTo ErrMsg:
Dim myFrm As Form, myCtl As Control
Dim mySelection As Variant
Dim iSelected, iCount As Long
Dim myDB As DAO.Database
Dim myRst As DAO.Recordset
Dim myRstCount As DAO.Recordset
Dim qdfMyQuery As DAO.QueryDef
Dim strSQLCount As String
Set myDB = CurrentDb()
Set qdfMyQuery = myDB.QueryDefs("qrySurveyAnswers")
[COLOR=Green] '1st try - Didn't work
'Error message: Error Number: 3061Error Description: Too few parameters
'Expected 1.Error Source: DAO.Database
'qdfMyQuery![Forms!frmSurvey!subActiveSurvey!subActiveQuestion!txtQuestionID] = _
' Forms![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID]
'2nd try - Didn't Work
'Error message: Error Number: 3061Error Description: Too few parameters
'Expected 1.Error Source: DAO.Database
'qdfMyQuery![Forms!frmSurvey!subActiveSurvey!subActiveQuestion!txtQuestionID] = _
' Forms![frmSurvey]![subActiveSurvey].Form![subActiveQuestion].Form![txtQuestionID]
'3rd try (current) - Didn't work..Different error message!
'Error message: Error Number: 3265Error Description: Item not found in this
'collection.Error Source: DAO.Parameters[/COLOR]
qdfMyQuery![Forms!frmSurvey!subActiveSurvey.Form!subActiveQuestion.Form!txtQuestionID] = _
Forms![frmSurvey]![subActiveSurvey].Form![subActiveQuestion].Form![txtQuestionID]
Set myRst = myDB.OpenRecordset("qrySurveyAnswers")
[COLOR=Green] 'Set myForm to this form (frmMultiSelectListBox)[/COLOR]
Set myFrm = Me
[COLOR=Green] 'Set myCtl to listbox[/COLOR]
Set myCtl = Me.cboAnswerID
iCount = 0
[COLOR=Green] 'Count number of selected records/items[/COLOR]
For Each mySelection In myCtl.ItemsSelected
iCount = iCount + 1
Next mySelection
[COLOR=Green] 'Check if anything is selected[/COLOR]
If iCount = 0 Then
MsgBox "There are no answers selected..", _
vbInformation, "Nothing selected!"
Exit Sub
End If
strSQLCount = "SELECT qryActiveAnswers.QuestionID, Count(qryActiveAnswers.AnswerID)" & _
"AS CountOfAnswerListID " & _
"FROM qryActiveAnswers " & _
"GROUP BY qryActiveAnswers.QuestionID " & _
"HAVING (((qryActiveAnswers.QuestionID)= " & _
[Forms]![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID] & "));"
Set myRstCount = myDB.OpenRecordset(strSQLCount, dbOpenSnapshot)
[COLOR=Green] 'See if there are any existing answers[/COLOR]
If myRstCount.RecordCount <> 0 Then
MsgBox "Already have " & myRstCount.Fields("CountOfAnswerListID") & " answers!", vbCritical, "Already answered..."
If MsgBox("Delete current answers and update with new answers?", vbYesNo + vbQuestion, "Delete?") = vbYes Then
[COLOR=Green] 'Delect existing answers[/COLOR]
DoCmd.RunSQL ("DELETE qryActiveAnswers.QuestionID " & _
"FROM qryActiveAnswers " & _
"WHERE (((qryActiveAnswers.QuestionID)=" & _
[Forms]![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID] & "));")
Else
MsgBox "Will not add answers at this time. Existing answers were not deleted.", vbInformation, "No changes..."
Exit Sub
End If
End If
iCount = 0
[COLOR=Green] 'Go throught each selected 'record' (ItemsSelected) in listbox[/COLOR]
[COLOR=Green] For Each mySelection In myCtl.ItemsSelected
'Current count of selected items[/COLOR]
iCount = iCount + 1
[COLOR=Green] 'Print value to Immediate Window[/COLOR]
'Debug.Print myCtl.ItemData(mySelection)
[COLOR=Green] 'Add answers[/COLOR]
With myRst
.AddNew
.Fields("QuestionID") = Forms![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID]
.Fields("AnswerNum") = iCount
.Fields("Answer") = myCtl.ItemData(mySelection)
.Update
End With
Next mySelection
[COLOR=Green] 'Requery form[/COLOR]
Me.Requery
qdfMyQuery.Close
myDB.Close
ResumeHere:
Exit Sub
ErrMsg:
MsgBox "Error Number: " & Err.Number & _
"Error Description: " & Err.Description & _
"Error Source: " & Err.Source, vbCritical, "Error!"
Resume ResumeHere:
End Sub