Outlook 2013, VBA, setting recurrence end date programatically not working

Question

I've stepped through this multiple times and it executes without issue. I even setup a watch on "Item.GetReccurrencePattern.PatternEndDate" for the calling procedure (i.e. Application_Reminder event) and the end date does change when my code is executed.

But, when I go back into Outlook and view my calendar, the additional meetings haven't been created.

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

I could really use some help figuring out what I've done wrong here. I don't do much programming for Outlook.

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

question from:https://stackoverflow.com/questions/65928114/outlook-2013-vba-setting-recurrence-end-date-programatically-not-working

Answer 1

Waitting for answers