Встреча Outlook 2016, созданная в Excel, только уведомляет меня - PullRequest
Новая
       52

Встреча Outlook 2016, созданная в Excel, только уведомляет меня

1 голос
/ 20 сентября 2019

Я пытаюсь настроить календарь Outlook на работе из таблиц Excel.Я запускаю запрос для получения данных, затем обрабатываю их и заполняю ими события календаря 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

Я думаю, что это просто параметр, который не перехватывает или что-то, потому что он работает просто отличнов моем собственном календаре я получаю напоминания, а также события.

Кто-то знает, где проблема?

Спасибо,

Adrien

РЕДАКТИРОВАТЬ: Я изменил код, чтобы сделать его минимальным воспроизводимым примером.

1 Ответ

0 голосов
/ 20 сентября 2019

Вы создали встречу с лишним свойством .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
...