Outlook VBA设置重复约会结束日期代码执行但未生效问题

代码全程无报错、单步监视到PatternEndDate值变更却未持久化，核心原因是操作的对象权限不匹配：

• Application_Reminder 事件传入的Item是触发提醒的单次重复实例（Occurrence），而非整个重复会议系列的主对象（Series Master）
• Occurrence对象上调用GetRecurrencePattern得到的规则对象，是主系列规则映射到当前实例的只读副本。直接给副本的PatternEndDate赋值，仅会修改当前内存中的临时值，单步监视时可以看到值变化，但该操作不会触发任何持久化写入
• 后续对Occurrence对象执行Save操作，仅会保存该单次实例的自定义修改，完全不会触达主系列的存储位置，因此日历不会生成新的重复项、原有会议的重复设置也不会展示更新后的结束日期。

所有涉及重复系列级别的配置变更，必须在真正的主系列（Series Master）对象上执行，具体改动点：

• 从触发提醒的Occurrence对象上提取主系列的唯一标识，通过Outlook会话重新加载主系列对象，所有重复规则修改都在该对象上完成
• 修复原代码中重复匹配olFriday的冗余分支逻辑，避免分支判断错漏
• 确认修改完重复规则后，显式调用主系列对象的Save方法，确保变更写入存储

Private Sub Application_Reminder(ByVal Item As Object)
    If Item.MessageClass <> "IPM.Appointment" Then Exit Sub
    ' 跳过非重复类的会议
    If Not Item.IsRecurring Then Exit Sub
    
    Dim DoIt As Boolean
    Select Case Item.ConversationTopic
        Case "TEST"
            DoIt = True
    End Select
    
    If DoIt Then
        ' 关键：通过会话加载真正的主系列对象，替代原始传入的Occurrence实例
        Dim seriesMaster As AppointmentItem
        Set seriesMaster = Application.Session.GetItemFromID(Item.ConversationID)
        ExtendAppt seriesMaster
        Set seriesMaster = Nothing
    End If
End Sub

Private Sub ExtendAppt(ByRef myApptItem As Outlook.AppointmentItem)
    ' 入参此时为真正的主系列对象，拥有重复规则的写入权限
    Dim myRecurrPatt As Outlook.RecurrencePattern
    Set myRecurrPatt = myApptItem.GetRecurrencePattern

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

    origEnd = myRecurrPatt.PatternEndDate

    ' 修复原代码重复匹配olFriday的冗余问题
    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 olSaturday: recDate = vbSaturday
        Case olSunday: recDate = vbSunday
        Case Else: Exit Sub ' 非有效重复规则直接退出
    End Select

    thisWeek = Date - Weekday(Date, recDate) + 1
    deltaEnd = DateDiff("ww", origEnd, thisWeek)
    howMany = IIf(deltaEnd Mod 2 = 0, 10, 9)
    newEnd = DateAdd("ww", howMany, thisWeek)

    ' 在主系列对象上修改重复规则并保存
    myRecurrPatt.PatternEndDate = newEnd
    myApptItem.Save

    Set myRecurrPatt = Nothing
    Set myApptItem = Nothing
End Sub

注意事项：Outlook对象模型对Occurrence类对象的重复规则属性不做严格的写入错误拦截，因此不会抛出“权限不足”类的运行时异常，只会出现属性赋值不生效的隐蔽问题，调试时需要优先确认当前操作的AppointmentItem是否为主系列对象。

内容的提问来源于stack exchange，提问作者CBRF23