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
