Selecting multiple choices in listbox

Kila

Registered User.
Local time
Yesterday, 20:51
Joined
Mar 5, 2003
Messages
275
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,

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
 
Anyone have any ideas here? Thanks!
 

Users who are viewing this thread

Back
Top Bottom