olAppointmentItem & .SendUsingAccount not working

jmulldome

New Member
Joined
Jan 28, 2021
Messages
1
Office Version
  1. 365
Platform
  1. Windows
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.

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

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Forum statistics

Threads
1,223,911
Messages
6,175,333
Members
452,636
Latest member
laura12345

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