Setting recurrence end date

159 Views Asked by At

I stepped through this multiple times and it executes without issue.

I set up a watch on "Item.GetReccurrencePattern.PatternEndDate" for the calling procedure (i.e. Application_Reminder event) and the end date does change.

But, when I view my calendar, the additional meetings haven't been created.

And when I open up an occurrence of the meeting, it shows the original end date in the recurrence settings.

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
0

There are 0 best solutions below