Блог

Главная - Вопросы по программированию - Установка даты окончания повторения

Установка даты окончания повторения

#vba #outlook #outlook-2013

#vba #outlook #outlook-2013

Вопрос:

Я прошел через это несколько раз, и он выполняется без проблем.

Я настроил наблюдение "Item.GetReccurrencePattern.PatternEndDate" для вызывающей процедуры (т. Е. Application_Reminder event ), И дата окончания меняется.

Но, когда я просматриваю свой календарь, дополнительные собрания не были созданы.

И когда я открываю событие собрания, оно показывает исходную дату окончания в настройках повторения.

 Private Sub Application_Reminder(ByVal Item As Object)

If Item.MessageClass <> "IPM.Appointment" Then Exit Sub
Dim myItem As AppointmentItem
Set myItem = Item
Dim DoIt As Boolean

Select Case myItem.ConversationTopic
    Case "TEST"
    DoIt = True
    
    'Will use this for multiple meetings, that's why using select
End Select
    
If DoIt Then ExtendAppt myItem
Set myItem = Nothing
End Sub



Private Sub ExtendAppt(ByRef myApptItem As Outlook.AppointmentItem)

Dim myRecurrPatt As Outlook.RecurrencePattern
Set myRecurrPatt = myApptItem.GetRecurrencePattern

Dim origStart As Date
Dim origEnd As Date
Dim thisWeek As Date
Dim recDate As Long
Dim deltaEnd As Long
Dim newEnd As Date
Dim howMany As Long

origStart = myRecurrPatt.PatternStartDate
origEnd = myRecurrPatt.PatternEndDate

Select Case myRecurrPatt.DayOfWeekMask
Case olFriday
    recDate = vbFriday
Case olMonday
    recDate = vbMonday
Case olTuesday
    recDate = vbTuesday
Case olWednesday
    recDate = vbWednesday
Case olThursday
    recDate = vbThursday
Case olFriday
    recDate = vbFriday
Case olSaturday
    recDate = vbSaturday
Case olSunday
    recDate = vbSunday
Case Else
    'not recurring or error
    Exit Sub
End Select

thisWeek = Date - Weekday(Date, recDate)   1

deltaEnd = DateDiff("ww", origEnd, thisWeek)

If deltaEnd Mod (2) = 0 Then howMany = 10 Else howMany = 9

newEnd = DateAdd("ww", howMany, thisWeek)

myRecurrPatt.PatternEndDate = newEnd

myApptItem.Save

'Release references to the appointment series
Set myApptItem = Nothing
Set myRecurrPatt = Nothing

End Sub

Комментарии:

1. Предложения: Измените myApptItem.Save на myApptItem.Display . Является ли myApptItem тем, что, по вашему мнению, должно быть? Если изменения были внесены, сохраните вручную, чтобы посмотреть, что произойдет.

2. Проверено, как предложено — подтверждено, что это ожидаемая встреча.

3. Ну, по состоянию на сегодняшний день, он начал выдавать ошибку в myApptItem.Save строке — говорит, что объект закрыт и больше не существует. Очень странно. Никаких изменений в коде, кроме того, что я добавил, а затем прокомментировал myApptItem.Display непосредственно перед методом сохранения. Действительно, очень странно.

4. Для возможных респондентов. Я получаю ожидаемые результаты. Как следует из комментария, новое поведение «объект закрыт и больше не существует» может не иметь прямого отношения к коду.

5. Вы пытаетесь обновить повторяющееся событие?

Метки: