设置重复结束日期

问题描述

我多次执行此操作，它执行没有问题。

我在 "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

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

outlook outlook-2013 vba