CODEWITHSUNDEEP
excelvbaoutlookappointment
SysRq
SysRq

Reputation: 28

Why does an outlook appointment not get deleted occasionally

I have a VBA macro in an Excel workbook that creates Outlook appointments with a special tag in the users calendar. Before it adds new appointments, it first deletes all appointments that have this tag in the items body. Unfortunately, the Outlook.AppointmentItem.Delete function sometimes does not work. When I have my Outlook calendar opened I can see that the item is deleted for a very short amount of time and instantly reappears. This happens only occasionally.

I can force that behavior by duplicating an AppointmentItem with the specific tag two times. Then, only two of the appointments are going to be deleted and one stays in the calendar.

Can anyone explain what might cause this behavior?

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

Upvotes: 0

Views: 241

Answers (1)

Grade &#39;Eh&#39; Bacon
Grade &#39;Eh&#39; Bacon

Reputation: 3833

To expand on Tim William's comment:

Imagine an array with item (1) "foo" and (2) "bar". You iterate "For each item in foobar()". It looks at item 1, and deletes it. Then the entire collection is shifted. Item (1) becomes "bar", and there is no more item 2. Your loop moves on, and looks at the next item - but because there is now only 1 item in the list, and it has just looped over item 1, its task is complete.

Solution: change your loop to move backwards from 2 down to 1. Except you can't do this with the "For Each x in y" command in VBA.

Instead, as @TimWilliams suggested, loop through the collection, add the id's to a new collection which is to be deleted, and then delete through that entire 'to delete' collection.

Upvotes: 1

Related Questions