Meeting uploader not emailing required attendees

[smit3446]

Hi all,

I've found some VBA code that I've catered to my own "Schedule Uploader" using the inputs in the table below to create meeting invites to Microsoft Outlook calendars. My one problem is that the required attendees are not getting the meeting emailed to them, and thus it is not showing up on their calendar. Could you take a look at my code and example table to see if I'm doing something wrong?

Subject	Location	Start Date	Start Time	End Time	Required Attendees
mtg1	Twin Lakes	11/4/2019	1:00 PM	1:30 PM	john.doe@gmail.com
mtg2	Twin Lakes	11/4/2019	1:30 PM	2:00 PM	jane.doe@gmail.com
mtg3	Twin Lakes	11/4/2019	2:00 PM	2:30 PM	john.doe@gmail.com; jane.doe@gmail.com

<tbody>
</tbody>

Sub RegisterAppointmentList()    ' adds a list of appontments to the Calendar in Outlook
    Dim olApp As Outlook.Application
    Dim olAppItem As Outlook.AppointmentItem
    Dim r As Long
    
    On Error Resume Next
    Worksheets("Schedule").Activate


    Set olApp = GetObject("", "Outlook.Application")
    On Error GoTo 0
    If olApp Is Nothing Then
        On Error Resume Next
        Set olApp = CreateObject("Outlook.Application")
        On Error GoTo 0
        If olApp Is Nothing Then
            MsgBox "Outlook is not available!"
            Exit Sub
        End If
    End If
    r = 2 ' first row with appointment data in the active worksheet
    Dim mysub, myStart, myEnd, attendees
    
    While Len(Cells(r, 1).Text) <> 0
        mysub = Cells(r, 1)
        myStart = DateValue(Cells(r, 3).Value) + Cells(r, 4).Value
        myEnd = DateValue(Cells(r, 3).Value) + Cells(r, 5).Value
        attendees = Cells(r, 6).Value
        'DeleteTestAppointments mysub, myStart, myEnd
        Set olAppItem = olApp.CreateItem(olAppointmentItem) ' creates a new appointment
        With olAppItem
            ' set default appointment values
            .Location = Cells(r, 2)
            .Body = ""
            .ReminderSet = True
            .BusyStatus = olFree
            .RequiredAttendees = attendees
            On Error Resume Next
            .Start = myStart
            .End = myEnd
            .Subject = Cells(r, 1)
            .Attachments.Add ("S:\P&C\College Recruiting\2020\Interviewees\" & Cells(r, 1) & ".pdf")
            .Location = Cells(r, 2).Value
            '.Body = .Subject & ", " & Cells(r, 4).Value
            .ReminderSet = True
            .BusyStatus = olBusy
            .Categories = "Orange Category" ' add this to be able to delete the testappointments
            On Error GoTo 0
            .Save ' saves the new appointment to the default folder
        End With
        r = r + 1
    Wend
    Set olAppItem = Nothing
    Set olApp = Nothing
    MsgBox "Done !"
End Sub

Thanks!

 

[Paul Ked]

I'm not sure, but would adding

            .ForceUpdateToAllAttendees = True

help?

 

[smit3446]

No dice, unfortunately. I've tried multiple iterations of declaring the recipient and so far no luck. I've tried:

[COLOR=#444444]' get the recipients[/COLOR]        Dim RequiredAttendee, OptionalAttendee, ResourceAttendee As Outlook.Recipient
        Set RequiredAttendee = .Recipients.Add(Cells(i, 10).Value) [COLOR=#444444]            RequiredAttendee.Type = olRequired[/COLOR]

^^ This gave me an object-defined error. I've also tried adding:

            .Recipients.Add Cells(r, 6).Value

And that didn't do anything, either. I've also added

.Send

to the end of the code. No luck.

 

[smit3446]

I should also add - the meeting uploads to my calendar just fine with all of the correct variables. I'm just trying to get this to email out to other attendees.

 

[smit3446]

SOLVED - I needed to add:

            .MeetingStatus = olMeeting

...so that indicates the appointment as a meeting request and allows recipients.

 

[Paul Ked]

Glad you've sorted it