Meeting uploader not emailing required attendees

smit3446

New Member
Joined
Nov 16, 2015
Messages
46
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?


[TABLE="width: 500"]
<tbody>[TR]
[TD]Subject[/TD]
[TD]Location[/TD]
[TD]Start Date[/TD]
[TD]Start Time[/TD]
[TD]End Time[/TD]
[TD]Required Attendees[/TD]
[/TR]
[TR]
[TD]mtg1
[/TD]
[TD]Twin Lakes[/TD]
[TD]11/4/2019[/TD]
[TD]1:00 PM[/TD]
[TD]1:30 PM[/TD]
[TD]john.doe@gmail.com[/TD]
[/TR]
[TR]
[TD]mtg2[/TD]
[TD]Twin Lakes[/TD]
[TD]11/4/2019[/TD]
[TD]1:30 PM[/TD]
[TD]2:00 PM[/TD]
[TD]jane.doe@gmail.com[/TD]
[/TR]
[TR]
[TD]mtg3[/TD]
[TD]Twin Lakes[/TD]
[TD]11/4/2019[/TD]
[TD]2:00 PM[/TD]
[TD]2:30 PM[/TD]
[TD]john.doe@gmail.com; jane.doe@gmail.com[/TD]
[/TR]
</tbody>[/TABLE]


Code:
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!
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
No dice, unfortunately. I've tried multiple iterations of declaring the recipient and so far no luck. I've tried:

Code:
[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:

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

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

Code:
.Send

to the end of the code. No luck.
 
Upvote 0
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.
 
Upvote 0
SOLVED - I needed to add:

Code:
            .MeetingStatus = olMeeting

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

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top