Adding Recipients to Appointment VBA

the code below creates a recurring Outlook appointment and another Outlook appointment through Excel and VBA. i'm trying to send the appointment to a different inbox, but i keep getting the "Run-time Error 287: Application-defined or object-defined error" at the line "OutlookAppt.Recipients.Add ("[email protected]")". the code works, except when i add this line, so i'm wondering why.

please let me know if you have any ideas as to how to fix this.

thank you a bunch in advance!

Sub CompleteReminders()
    Dim rows
    Dim sDate As Date, newFU As Date, newDate As Date, iDate As Date, generalDate As Date
    Dim iValue As Integer
    Dim iteration As Integer
    Dim LastRow As Long
    Dim i As Long
    Dim x As Integer
    Dim xRg As Range
    Dim myNamespace As Object
    Dim objfolder As Outlook.Folder
    Dim OutlookAppt As Outlook.AppointmentItem
    Dim OutlookAppt2 As Outlook.AppointmentItem
    Dim myRecurrPatt As Outlook.RecurrencePattern
    Const olFolderCalendar = 9
    Const olAppointment = 26
    Dim n As Integer

    Set OutApp = GetObject(, "Outlook.Application")
        If ErrL <> 0 Then
            Set OutApp = CreateObject("Outlook.Application")
        End If

    Set myNamespace = OutApp.GetNamespace("MAPI")
    Set objfolder = myNamespace.PickFolder 'Sets folder where appt will be created
    Set xRg = Range("B6:D6")
                Set OutlookAppt = OutApp.CreateItem(1)
                OutlookAppt.Duration = 5
                Set myRecurrPatt = OutlookAppt.GetRecurrencePattern
                With myRecurrPatt
                .PatternStartDate = Range("C1").Value
                .RecurrenceType = olRecursMonthNth
                .Interval = Range("C3").Value
                .PatternEndDate = dateEnd
                .StartTime = #5:00:00 PM#
                .EndTime = #5:05:00 PM#
                End With
                OutlookAppt.Subject = xRg.Cells(1, 1).Value
                If xRg.Cells(1, 2).Value > 0 Then
                    OutlookAppt.ReminderSet = True
                    OutlookAppt.ReminderMinutesBeforeStart = xRg.Cells(4, 6).Value
                    OutlookAppt.ReminderSet = False
                End If
                OutlookAppt.Body = xRg.Cells(1, 3).Value
                OutlookAppt.BusyStatus = olFree
                OutlookAppt.Recipients.Add ("[email protected]")
                Set OutlookAppt = objfolder.Items.Add(olAppointmentItem)
End Sub


  • If your code is running unattended, make sure the security prompt is not getting in the way. Make sure antivirus app and its definitions are up-to-date.

    Also try to replace the problematic line line with

    OutlookAppt.RequiredAttendees = "[email protected]"

    For the RequiredAttendees property, only reading is blocked, but not setting.