Jan 28 2021 06:56 AM
Jan 28 2021 06:56 AM
Just a quick introduction to what I'm trying to do, and the roadblock I'm encountering.
I'm attempting to automate with VBA sending a calendar invite, but doing so on behalf of another. When I run the code below, the calendar invite populates just fine with all of the relevant information (date, time, body, etc.), but instead of sending on behalf of (or from) the designated email address, it still sends it from my own email.
I have also tried using .SendOnBehalfOfName in place of .SendUsingAccount, and that throws an error ("Object doesn't support this property or method")
Any help would be appreciated. PLEASE NOTE: "Cells(r, 10).Value" is the cell where the "on behalf of" email address exists in the worksheet. I have also tried just entering the "on behalf of" email address in this spot in quotation marks.
I should add that, yes, I have full access to the "on behalf of" email address.
When I attempt to schedule something on behalf of that email address manually in Outlook, it works just fine.
Sub AddAppointments() Dim myoutlook As Object ' Outlook.Application Dim r As Long Dim myapt As Object ' Outlook.AppointmentItem ' late bound constants Const olAppointmentItem = 1 Const olBusy = 2 Const olMeeting = 1 ' Create the Outlook session Set myoutlook = CreateObject("Outlook.Application") ' Start at row 2 r = 2 Do Until Trim$(Cells(r, 1).Value) = "" ' Create the AppointmentItem Set myapt = myoutlook.CreateItem(olAppointmentItem) ' Set the appointment properties With myapt .SendUsingAccount = Cells(r, 10).Value .Subject = Cells(r, 1).Value .Location = Cells(r, 2).Value .Start = Cells(r, 3).Value .Duration = Cells(r, 4).Value .Recipients.Add Cells(r, 8).Value .MeetingStatus = olMeeting ' not necessary if recipients are email addresses ' myapt.Recipients.ResolveAll .AllDayEvent = Cells(r, 9).Value ' If Busy Status is not specified, default to 2 (Busy) If Len(Trim$(Cells(r, 5).Value)) = 0 Then .BusyStatus = olBusy Else .BusyStatus = Cells(r, 5).Value End If If Cells(r, 6).Value > 0 Then .ReminderSet = True .ReminderMinutesBeforeStart = Cells(r, 6).Value Else .ReminderSet = False End If .Body = Cells(r, 7).Value .Display '.Save r = r + 1 '.Send End With Loop End Sub