How to delete appointments?

0
votes

I have code that is supposed to loop through all future appointments; and if they match a certain criteria, delete them from the calendar.

Sub DeleteFutureImportedCalendarItems()
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim objAppointment As Outlook.AppointmentItem

    Dim strSubject As String
    Dim strLocation As String
    Dim dteStartDate As Date
    Dim Category As String
     
    '******************************** Set Criteria for DELETION here ********************************
    strSubject = "[Imported]"
    strLocation = "AC"
    dteStartDate = Date
    Category = "Yellow Category"
    '************************************************************************************************
     
    Set objOutlook = Outlook.Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNamespace.GetDefaultFolder(olFolderCalendar)
     
    For Each objAppointment In objFolder.Items
    
      If Right(objAppointment.Subject, 10) = strSubject And objAppointment.Location = strLocation And _
         objAppointment.Start >= dteStartDate And objAppointment.Categories = Category  Then
           objAppointment.Delete
          
      End If
    Next

End Sub

This does not delete all of the appointments that meet the criteria. If I run the code multiple times, it grabs a few more each time, but I have to run this 5 or 6 times to get all of them.

1
vbaforeachoutlook

1 Answers

2
votes

Deleting an item changes the collection. Loop from Count down to 1 instead:

set oItems = objFolder.Items
for i = oItems.Count to 1 step -1 do
  set objAppointment = oItems.Item(I)
  ...