为什么预约不会偶尔删除

我有一个Excel工作簿中的VBAmacros,用户日历中用特殊标记创buildOutlook约会。 在添加新的约会之前,它首先删除在物品主体中具有该标签的所有约会。 不幸的是,Outlook.AppointmentItem.Delete函数有时不起作用。 当我打开我的Outlook日历时,我可以看到该项目被删除很短的时间,并立即重新出现。 这只是偶尔发生。

我可以通过使用特定标记两次复制AppointmentItem来强制执行此行为。 然后,只有两个约会将被删除,一个保留在日历中。

任何人都可以解释什么可能导致此行为?

Public Sub DeleteAppointment(Starttime As Date, Endtime As Date) Dim myStart As Date Dim myEnd As Date Dim olApp As Outlook.Application Dim oCalendar As Outlook.Folder Dim oItems As Outlook.Items Dim oItemsInDateRange As Outlook.Items Dim oAppt As Outlook.AppointmentItem Dim strRestriction As String Dim olNs As Outlook.Namespace Dim blnCreated As Boolean On Error Resume Next Set olApp = Outlook.Application If olApp Is Nothing Then Set olApp = Outlook.Application blnCreated = True Err.Clear Else blnCreated = False End If On Error GoTo 0 myStart = Starttime myEnd = DateAdd("h", 24, Starttime) 'MsgBox ("Searching from " & Format(myStart, "mm.dd.yyyy hh:mm") & " to " & Format(myEnd, "mm.dd.yyyy hh:mm")) 'Construct filter for the range strRestriction = "[Start] <= '" & myEnd & "' AND [End] >= '" & myStart & "'" ' Set Outlook Objects Set olNs = olApp.GetNamespace("MAPI") Set oCalendar = olNs.GetDefaultFolder(olFolderCalendar) Set oItems = oCalendar.Items oItems.IncludeRecurrences = True oItems.Sort "[Start]" 'Restrict the Items collection for the range Set oItemsInDateRange = oItems.Restrict(strRestriction) oItemsInDateRange.Sort "[Start]" For Each oAppt In oItemsInDateRange 'MsgBox ("Found item " & oAppt.Subject & " from " & oAppt.Start & " to " & oAppt.End) If (InStr(oAppt.Body, OutlookTag) <> 0) Then 'MsgBox ("Found an appointment that I generated. Going to delete it." & oAppt.Subject) oAppt.Delete Set oAppt = Nothing End If Next End Sub 

为了扩大Tim William的评论:

想象一下带有项目(1)“foo”和(2)“bar”的数组。 你迭代“对foobar()中的每个项目”。 它看在项目1,并删除它。 然后整个集合被转移。 项目(1)变成“酒吧”,不再有项目2.你的循环继续前进,看着下一个项目 – 但是因为现在在列表中只有一个项目,而且它刚刚绕过项目1,其任务完成。

解决scheme:改变你的循环从2向下移动到1.除了你不能用VBA中的“For Each x in y”命令来做到这一点。

相反,正如@TimWilliamsbuild议的那样,循环访问集合,将id添加到要删除的新集合,然后删除整个“删除”集合。