Как синхронизировать измененные повторяющиеся встречи между Outlook.Com и Exchange

Question

Я хочу, чтобы мой календарь Exchange Outlook (только дата / время и информация о теме) синхронизировался с другим календарем на outlook.com.

Я использую события ItemAdd и ItemChange, и мне удалось заставить его работать для всех этих условий, кроме условия # 6.

Ошибка из-за того, что GetOccurrence () вызвала ошибку.

Условия, по которым я начал работать:

1. Создать новую встречу
2. Изменение существующей встречи
3. Создание новой повторяющейся встречи
4. Изменение существующей повторяющейся встречи путем изменения серии
5. Изменение одного из существующих повторяющихся встреч в первый раз

Я не мог заставить это работать:

Изменить одно из существующих повторяющихся назначений на последующее время

Для последнего условия, я подозреваю, уже создано исключение, поэтому GetOccurrence () создаст его снова и, следовательно, ошибку.

Я полагаю, что проблема в этом сегменте кода.

            Set TargetAppt = TargetRecurrPatt.GetOccurrence(ItemRecurrPatt.Exceptions.Item(i).OriginalDate)
            If Not ((TargetAppt.Start = ItemRecurrPatt.Exceptions.Item(i).AppointmentItem.Start) And _
                    (TargetAppt.Duration = ItemRecurrPatt.Exceptions.Item(i).AppointmentItem.Duration)) Then
                    TargetAppt.Start = ItemRecurrPatt.Exceptions.Item(i).AppointmentItem.Start
                    TargetAppt.Duration = ItemRecurrPatt.Exceptions.Item(i).AppointmentItem.Duration
                    TargetAppt.Save
                    bSave = True
            End If
            Set TargetAppt = Nothing
        Next

Полная функция дублирования собрания заключается в следующем.

Private Sub DuplicateMeeting(ByRef Item As AppointmentItem, ByRef Target As AppointmentItem, ByVal bNew As Boolean)
'Item: Original Appt. Target:duplicated Appt. bNew: Is this s new meeting or update of an exiting meeting?

Dim TargetRecurrPatt As Outlook.RecurrencePattern
Dim ItemRecurrPatt As Outlook.RecurrencePattern
Dim TargetAppt As Outlook.AppointmentItem
Dim cApptException As Outlook.Exception
Dim i As Long
Dim bSave As Boolean

bSave = False
With Target
    If bNew Then
        .Subject = Item.Subject
        .Location = Item.Location
        .Duration = Item.Duration
        .Body = "DuplicateMeeting" & vbCr & "Main Cal:" & Right(Item.GlobalAppointmentID, 16) & "  Duplicate cal:" & Right(.GlobalAppointmentID, 16) & _
                vbCr & "Organizer: " & .Organizer

        If .MeetingStatus = olNonMeeting Then  'olMeeting =1 olNonMeeting=0  olMeetingCanceled=5
            .MeetingStatus = olMeeting
        End If
        Debug.Assert Item.Recipients.Count < 50
        For i = Item.Recipients.Count To 1 Step -1
            .Body = .Body & Item.Recipients(i)
        Next
        Debug.Assert Target.Recipients.Count < 50

        For i = .Recipients.Count To 1 Step -1
            .Recipients(i).Delete
        Next
        .Recipients.Add ("XX@outlook.com")
        bSave = True
    Else
        If Not ((.Subject = Item.Subject) And _
            (.Location = Item.Location) And _
            (.Duration = Item.Duration)) Then
            .Subject = Item.Subject
            .Location = Item.Location
            .Duration = Item.Duration
            bSave = True
        End If


    End If
    If Item.IsRecurring Then
        'Assume recurring meeting will not be updated. Org will change individual meeting instead.
        Set TargetRecurrPatt = Target.GetRecurrencePattern
        Set ItemRecurrPatt = Item.GetRecurrencePattern
        If Not ((TargetRecurrPatt = Item.GetRecurrencePattern) And _
            (TargetRecurrPatt.RecurrenceType = ItemRecurrPatt.RecurrenceType) And _
            (TargetRecurrPatt.PatternStartDate = ItemRecurrPatt.PatternStartDate) And _
            (TargetRecurrPatt.PatternEndDate = ItemRecurrPatt.PatternEndDate) And _
            (TargetRecurrPatt.StartTime = ItemRecurrPatt.StartTime)) Then
                TargetRecurrPatt = Item.GetRecurrencePattern
                TargetRecurrPatt.RecurrenceType = ItemRecurrPatt.RecurrenceType
                TargetRecurrPatt.PatternStartDate = ItemRecurrPatt.PatternStartDate
                TargetRecurrPatt.PatternEndDate = ItemRecurrPatt.PatternEndDate
                TargetRecurrPatt.StartTime = ItemRecurrPatt.StartTime
                bSave = True
        End If
    Else
        If (Not .Start = Item.Start) Then
            .Start = Item.Start
            bSave = True
        End If
    End If
    'Must save for the exception below to work
    If bSave Then .Save  '=> Error: Operation failed
    'The above reset the recurring meeting at BackupCal. Next step is to search for exception

    i = 1
    If Item.IsRecurring Then
        On Error GoTo GetOccurrenceErrorHandler
        Debug.Print "Exception count:", ItemRecurrPatt.Exceptions.Count
        ' GetOccurrence create an exception but must first use the origianl date
        For i = 1 To ItemRecurrPatt.Exceptions.Count
            Set TargetAppt = TargetRecurrPatt.GetOccurrence(ItemRecurrPatt.Exceptions.Item(i).OriginalDate)
            If Not ((TargetAppt.Start = ItemRecurrPatt.Exceptions.Item(i).AppointmentItem.Start) And _
                    (TargetAppt.Duration = ItemRecurrPatt.Exceptions.Item(i).AppointmentItem.Duration)) Then
                    TargetAppt.Start = ItemRecurrPatt.Exceptions.Item(i).AppointmentItem.Start
                    TargetAppt.Duration = ItemRecurrPatt.Exceptions.Item(i).AppointmentItem.Duration
                    TargetAppt.Save
                    bSave = True
            End If
            Set TargetAppt = Nothing
        Next


        On Error GoTo 0
        Set TargetRecurrPatt = Nothing
        Set ItemRecurrPatt = Nothing
        Set cApptException = Nothing
    End If

    If bSave Then
        .Save
        .Send
        Debug.Print Now, "Save and sent"
    End If
End With

Exit Sub
GetOccurrenceErrorHandler:
    Debug.Print Now, "DuplicateMeeting Expection GetOccurrence", ItemRecurrPatt.Exceptions.Item(i).OriginalDate, ItemRecurrPatt.Exceptions.Item(i).AppointmentItem.Start

    Resume Next

End Sub