Excel 创建的 Outlook 约会只通知我

Question

我正在尝试从 Excel 数据表中设置 Outlook 日历。

我运行查询以获取数据，然后对其进行处理，并填写 Outlook 日历事件。
问题是，当我通过我的 olAppointmentItem 输入所需的与会者时，它只会通知我并填写我的日历，而不是我同事的日历。
我认为这可能是因为我是使用自己的 Outlook 帐户创建的。

这是我的 Excel 工作表的映射：

这是我使用的代码：

Sub RegisterAppointmentList()
    ' adds a list of appointments to the Calendar in Outlook
    Dim olApp As Outlook.Application
    Dim olAppItem As Outlook.AppointmentItem
    Dim row As Long

    On Error Resume Next
    Worksheets("to_be_added").Activate 'worksheet with the list of my appointments to be added

    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
    row = 2 ' first row with appointment data in the active worksheet
    Dim mysub, myStart, myEnd
    While Len(Cells(row, 2).text) <> 0
        mysub = "Test"
        myStart = DateValue("09/20/2019") + TimeValue("8:00") 'date and time
        myEnd = DateValue("09/20/2019") + TimeValue("9:00") 'date and time
        Set olAppItem = olApp.CreateItem(olAppointmentItem) 
            ' set default appointment values
            .Location = "Office" 'Location of my event
            .Body = "Test appointment" 'title
            .ReminderSet = True
            .BusyStatus = olBusy 'doesn't need to set people busy
            ```
            .RequiredAttendees = "me@company.com" 'this works just fine
            .RequiredAttendees = "colleague@company.com" 'this doesn't work
            ```
            'On Error Resume Next
            .Start = myStart
            .End = myEnd
            .AllDayEvent = False
            .Subject = mysub
            '.Location = Cells(row, 9).Value
            '.Body = Cells(row, 8).Value
            '.ReminderSet = True
            '.BusyStatus = olBusy
            .Categories = "In" 'My own categories (two possibilities, In or Out)
            On Error GoTo 0
            .Save 
        End With
        row = row + 1
    Wend
    Set olAppItem = Nothing
    Set olApp = Nothing
End Sub

我认为这只是一个没有捕获的参数或其他东西，因为它在我自己的日历上运行良好，我得到提醒和事件。

Answer 1

您使用多余的.RequiredAttendees 属性创建了约会。

你没有尝试.Send。

Sub RegisterAppointmentList_SendMeetingInvitation_Minimal()

    ' Most Excel-related code is removed

    ' Create a meeting from an appointment
    Dim olApp As Outlook.Application
    Dim olAppItem As Outlook.AppointmentItem

    Dim myStart As Date
    Dim myEnd As Date

    On Error Resume Next
    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

    myStart = DateValue("09/21/2019") + TimeValue("8:00") 'date and time
    myEnd = DateValue("09/21/2019") + TimeValue("9:00") 'date and time

    Set olAppItem = olApp.CreateItem(olAppointmentItem)

    With olAppItem

        ' set default appointment values
        .Location = "Office" 'Location of my event
        .Body = "Test appointment"
        .ReminderSet = True
        .BusyStatus = olBusy

        .RequiredAttendees = "me@company.com"
        .RequiredAttendees = "colleague@company.com"

        .Start = myStart
        .End = myEnd
        .AllDayEvent = False
        .Subject = "Test"

        ' Change appointment to meeting
        .MeetingStatus = olMeeting

        .Display ' change to .Send when tested

    End With

End Sub