我在Excel工作簿中有一个VBA宏,用于在用户日历中创建带有特殊标记的Outlook约会。在添加新约会之前,它首先删除在商品正文中具有此标记的所有约会。不幸的是,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
答案 0 :(得分:1)
扩展蒂姆威廉的评论:
想象一个带有项目(1)“foo”和(2)“bar”的数组。您迭代“对于foobar中的每个项目()”。它查看项目1,并删除它。然后移动整个集合。项目(1)变为“bar”,并且没有更多项目2.你的循环继续前进,并查看下一个项目 - 但是因为列表中现在只有一个项目,它刚刚在项目1上循环,它的任务已经完成。
解决方案:更改循环以从2向下移动到1.除非您无法使用VBA中的“For Each x in y”命令执行此操作。
相反,正如@TimWilliams建议的那样,遍历集合,将id添加到要删除的新集合中,然后通过整个“删除”集合删除。