Item not in Collection

[Wayne]

I posted this about a year ago, and was getting query problems. I played with it and solved the query problem, and then was getting an error message saying "Too few parameters. Expected 1". So again I played with it. As near as I could figure it, Access was having a problem with the Form, so I put in a parameter to resolve this. Now I get an error message saying "Item not in this collection".

I have been trying to solve this one on my own, but would sure appreciate some help.

Private Sub btnCreateAppointment_Click()
On Error GoTo Err_btnCreateAppointment_Click

    'First Save the Current Record
    DoCmd.RunCommand acCmdSaveRecord
    
    'Exit the procedure if the appointment has already been added to the Outlook Calendar
    If Me.ApptAddedtoOutlook = True Then
        MsgBox "This appointment has already been added to the Outlook Calendar.", vbOKOnly, "Crate & Pack"
        Exit Sub
    Else
        Dim olObj As Outlook.Application
        Dim olAppt As Outlook.AppointmentItem
        Dim olName As Outlook.NameSpace
        Dim olFldr As Outlook.MAPIFolder
        Dim strNotes As String
        Dim strLocation As String
        Dim strContact As String
        Dim strSQL As String
        Dim db As DAO.Database
        Dim rst As DAO.Recordset
        Dim qdf As DAO.QueryDef
        
        Set olObj = CreateObject("Outlook.Application")
        Set olAppt = olObj.CreateItem(olAppointmentItem)
        Set olName = olObj.GetNamespace("MAPI")
        Set olFldr = olName.GetDefaultFolder(olFolderCalendar)
    
        If Not IsNull(Me.ClientAptNumber) Then
            strLocation = ("# " & Me.ClientAptNumber & " - " & Me.ClientStreetAddress & ", " & Me.ClientCityName & ", " & Me.ClientState & "  " & Me.ClientZipCode)
        Else
            strLocation = (Me.ClientStreetAddress & ", " & Me.ClientCityName & ", " & Me.ClientState & "  " & Me.ClientZipCode)
        End If
        
        If Not IsNull(Me.ClientPhone2) Then
            strContact = (Me.ClientPhone1 & " " & Me.ClientPhoneType1 & "  " & Me.ClientPhone2 & " " & Me.ClientPhoneType2)
        Else
            strContact = (Me.ClientPhone1 & " " & Me.ClientPhoneType1)
        End If
        
        strSQL = "SELECT tblOrderDetails.Quantity, tblOrderDetails.ServiceType, tblOrderDetails.ServiceDetails " & vbCrLf & _
                "FROM tblOrders INNER JOIN tblOrderDetails ON tblOrders.OrderNumber = tblOrderDetails.OrderNumber " & vbCrLf & _
                "WHERE ((tblOrderDetails.ServiceType)<>'Trip Charge') AND  ((tblOrderDetails.ServiceType)<>'Tax Exempt') AND ((tblOrderDetails.OrderNumber)=[Forms]![frmOrders]![OrderNumber]) " & vbCrLf & _
                "ORDER BY tblOrderDetails.ServiceType;"
                               
        Set db = CurrentDb()
        Set qdf = db.QueryDefs("strSQL")
            qdf("[Forms]![frmOrders]![OrderNumber]") = Me.OrderNumber.Value
        Set rst = qdf.OpenRecordset
               
        With rst
            Do Until rst.EOF
            rst.MoveLast
            rst.MoveFirst
            strNotes = rst.Fields("Quantity") & vbTab & rst.Fields("ServiceType") & " - " & rst.Fields("ServiceDetails") & vbCrLf
            rst.MoveNext
            Loop
        End With
                                               
    With olAppt
        .Start = Me.ServiceDate & " " & Me.ApptTime
        .Duration = Me.ApptDuration
        .Subject = (Me.CustNumber & " - Service Appointment - " & Me.OrderNumber & "    " & Me.ClientUserlastName & ", " & Me.ClientUserFirstName)
        .Location = strLocation & "   " & strContact
        If Me.ApptReminder = True Then
        .ReminderSet = True
        .ReminderMinutesBeforeStart = Me.ReminderMinutes
        End If
        .RequiredAttendees = "myemail"
        .Body = strNotes
        .Save
        
    End With
    End If
    
        'Release the Outlook object variables
        Set olObj = Nothing
        Set olAppt = Nothing
        Set olName = Nothing
        Set olFldr = Nothing
        Set rst = Nothing
        Set db = Nothing
    
        'Set the Added to Outlook flag, save the record, and display a message
        Me.ApptAddedtoOutlook = True
        DoCmd.RunCommand acCmdSaveRecord
        MsgBox "Appointment Added", vbOKOnly, "Crate & Pack"
        
    Exit Sub
          
Exit_btnCreateAppointment_Click:
    Exit Sub
    
Err_btnCreateAppointment_Click:
    MsgBox Err.Description, vbOKOnly, "Crate & Pack"
    Resume Exit_btnCreateAppointment_Click
        
End Sub

Maybe some fresh eyes on it could spot what I can't.

Wayne

 

[sneuberg]

I suggest trying the full reference and the parameters collection. Something like:

  qdf.Parameters("[Forms]![frmOrders]![OrderNumber]") = [Forms]![frmOrders]![OrderNumber]

in place of

  qdf("[Forms]![frmOrders]![OrderNumber]") = Me.OrderNumber.Value

 

[Wayne]

Thanks Steve. Tried that, but still getting the same error message. I double-checked all of the table and field names to make sure they are right (and they are), but I still can't figure it out.

Any more thoughts?

Wayne

 

[MarkK]

What line causes the error?

How is this not an endless loop? Also, the With block is never used???

  With rst
         Do Until rst.EOF
            rst.MoveLast
            rst.MoveFirst
            strNotes = rst.Fields("Quantity") & vbTab & rst.Fields("ServiceType") & " - " & rst.Fields("ServiceDetails") & vbCrLf
            rst.MoveNext
         Loop
  End With

hth
Mark