为什么偶尔不会删除Outlook预约

时间:2015-10-01 16:24:49

标签: excel vba outlook appointment

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

1 个答案:

答案 0 :(得分:1)

扩展蒂姆威廉的评论:

想象一个带有项目(1)“foo”和(2)“bar”的数组。您迭代“对于foobar中的每个项目()”。它查看项目1,并删除它。然后移动整个集合。项目(1)变为“bar”,并且没有更多项目2.你的循环继续前进,并查看下一个项目 - 但是因为列表中现在只有一个项目,它刚刚在项目1上循环,它的任务已经完成。

解决方案:更改循环以从2向下移动到1.除非您无法使用VBA中的“For Each x in y”命令执行此操作。

相反,正如@TimWilliams建议的那样,遍历集合,将id添加到要删除的新集合中,然后通过整个“删除”集合删除。