Создайте встречи Outlook в общем календаре из Excel с напоминаниями для необходимых посетителей

Question

Проблема:

Цель - Часть 1 - Создать встречи в общем календаре Outlook из электронной таблицы Excel с прим. 150 отдельных назначений. Я смог успешно это сделать.

Цель - часть 2 - В рамках импорта этой встречи я хочу добавить необходимых участников, отправить приглашение и автоматически принять это приглашение в свой календарь, чтобы они получили напоминание (можно изменить настройку в Outlook, чтобы автоматически принимать приглашения, надеюсь, это работает). Я действительно застрял с этим, не знаю, как go об этом.

Моя рабочая среда Windows 7 с MS Office 2016 Suite, также SharePoint / Office365.

То, что я пробовал: Я довольно плохо знаком с VBA / макросами, это моя первая настоящая попытка его использовать, поэтому я исследовал и нашел макрос, созданный кем-то другим. чтобы основать мою.

Я попытался добавить к этому код, такой как ".Recipients.Add", "RequiredAttendees = Cells (i, 11)", однако макрос просто пропускает строки Excel, в которые я добавил посетителя.

Я также попробовал "Recipients.Add (" email@email.com) ", который добавил электронное письмо к встрече, но не отправил встречу на это письмо.

Изменения / изменения описанные выше были предприняты попытки в этом разделе кода:

    'Define calendar item properties

    .Start = Cells(i, 6) + Cells(i, 7)     '+ TimeValue("9:00:00")
    .End = Cells(i, 8) + Cells(i, 9)       '+TimeValue("10:00:00")

    .Subject = Cells(i, 2)
    .Location = Cells(i, 3)
    .Body = Cells(i, 4)
    .BusyStatus = olBusy
    .ReminderMinutesBeforeStart = Cells(i, 10)
    .ReminderSet = True
    .Categories = Cells(i, 5)
    .ResponseRequested = False
    .Save

Любая помощь будет принята с благодарностью!

Код (в настоящее время используется, открыт для изменения):

    Public Sub CreateOutlookAppointments()

       Sheets("Marketing Schedule 2020").Select

        On Error GoTo Err_Execute

        Dim olApp As Outlook.Application
        Dim olAppt As Outlook.AppointmentItem
        Dim blnCreated As Boolean
        Dim olNs As Outlook.Namespace
        Dim CalFolder As Outlook.MAPIFolder
        Dim subFolder As Outlook.MAPIFolder
        Dim arrCal As String

        Dim i As Long

        On Error Resume Next
        Set olApp = Outlook.Application

        If olApp Is Nothing Then
            Set olApp = Outlook.Application
             blnCreated = True
            Err.Clear
        Else
            blnCreated = False
        End If

        On Error GoTo 0

        Set olNs = olApp.GetNamespace("MAPI")
        Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)

        i = 2
        Do Until Trim(Cells(i, 1).Value) = ""
        arrCal = Cells(i, 1).Value
        Set subFolder = CalFolder.Folders(arrCal)
         If Trim(Cells(i, 11).Value) = "" Then
        Set olAppt = subFolder.Items.Add(olAppointmentItem)

        'MsgBox subFolder, vbOKCancel, "Folder Name"

        With olAppt

        'Define calendar item properties
            .Start = Cells(i, 6) + Cells(i, 7)     '+ TimeValue("9:00:00")
            .End = Cells(i, 8) + Cells(i, 9)       '+TimeValue("10:00:00")


            .Subject = Cells(i, 2)
            .Location = Cells(i, 3)
            .Body = Cells(i, 4)
            .BusyStatus = olBusy
            .ReminderMinutesBeforeStart = Cells(i, 10)
            .ReminderSet = True
            .Categories = Cells(i, 5)
            .ResponseRequested = False
            .Save

        End With
        Cells(i, 12) = "Imported"

        End If

            i = i + 1
            Loop
        Set olAppt = Nothing
        Set olApp = Nothing
         ThisWorkbook.Save
        Exit Sub


Err_Execute:  
       MsgBox "An error occurred - Exporting items to Calendar."

         End Sub