Trying to Create Appointment in Outlook from Access

Waynes World · May 27th, 2015, 10:42 PM

I have an Access database for my contracting business. On the main form, it contains all of the relevant information about the client (name, address, service date, etc.). On the main form, I have a subform which contains multiple records, listing each item of work to be done in the client's home (one record for each item of work to be done).

I have written the code in the OnClick event of a command button to create the Appointment in my Outlook Calendar, and in the notes section of the appointment, I want all of the records from the subform showing the work to be done. When I execute the code, I get an error message of "Too few parameters. Expected 2." The code is below:

Code:

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 strLocation As String
        Dim strContact As String
        Dim strSQL As String
        Dim db As DAO.Database
        Dim rst As DAO.Recordset
    
        Set olObj = CreateObject("Outlook.Application")
        Set olAppt = olObj.CreateItem(olAppointmentItem)
    
        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 " & _
                "FROM tblOrders INNER JOIN tblOrderDetails ON tblOrders.OrderNumber = tblOrderDetails.OrderNumber " & _
                "WHERE tblOrderDetails.ServiceType <> ""Trip Charge"" Or tblOrderDetails.ServiceType <> ""Tax Exempt"" " & _
                "And tblOrderDetails.OrderNumber = " & [Forms]![frmOrders]![OrderNumber] & " " & _
                "ORDER BY tblOrderDetails.ServiceType"
                               
        Set db = CurrentDb()
        Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
               
        With rst
            .MoveFirst
            Do Until rst.EOF
            strSQL = rst.Fields("Quantity") & vbTab & _
            rst.Fields("ServiceType") & " - " & _
            rst.Fields("ServiceDetails") & vbCrLf
            DoCmd.SendObject acSendNoObject, , , , , , strSQL, , False, False
            .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 = strSQL
        .Save
        
    End With
    End If
    
        'Release the Outlook object variables
        Set olObj = Nothing
        Set olAppt = 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

With the main form open, when I run the SQL query, it works perfectly, giving me all the records for that specific client. But when I execute the code to add the appointment, I get the error message.

I have searched several forums for help but so far no luck. Could someone please point me in the right direction? I would appreciate any help I can get.

Waynes World