How to delete all appointments? - vba

Question

I am trying to delete all appointments from an Excel VBA (Excel 2010) macro.
I get an Error 13 (Type Mismatch) on olFolder.Items.GetFirst.
It ran a few weeks ago.
Sub DeleteAllAppointments()
Dim olApp As Object
Application.ScreenUpdating = False
Set olApp = CreateObject("Outlook.Application")
Dim olApptItem As Outlook.AppointmentItem
Dim olMeetingItem As Outlook.MeetingItem
Dim olNameSpace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olObject As Object
Dim olItems As Items
Dim i As Double
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderCalendar)
Set olItems = olFolder.Items
Set olApptItem = olFolder.Items.GetFirst
For i = 1 To olItems.Count
If olItems.Count > 1 Then
olApptItem.Delete
Set olApptItem = olFolder.Items.GetNext
Else
Set olApptItem = olFolder.Items.GetLast
olApptItem.Delete
End If
Next
End Sub

Answer 1

As already mentioned you should delete them in reverse order - as they are re-indexed each time and you eventually try to refer to an item that doesn't exist.
You don't need to Set the next item in the loop as you can use Remove(i) to delete a particular item:
For i = olItems.Count To 1 Step -1
If TypeOf olItems(i) Is olApp.AppointmentItem Then
olItems.Remove (i)
End If
Next i
However, this code will delete EVERY appointment, because practically everything within the calendar is an AppointmentItem. If you don't want to delete, for example, a Meeting then you need to read some property such as MeetingStatus, which is 1 for a Meeting and 0 for a Non-Meeting:
For i = olItems.Count To 1 Step -1
If TypeOf olItems(i) Is olApp.AppointmentItem Then
If olItems(i).MeetingStatus = 0 Then
olItems.Remove (i)
End If
End If
Next i
From Excel though, using olAppointment may be preferable to AppointmentItem because you can substitute the numeric value of 26 if necessary: If olItems(i).Class = 26.

Answer 2

Usually that means that you actually have some items in your folder that are not an Appointment item. You need to test what the item is before assuming that it is an appointment. This is true even when the folder is set to only contain appointment items.
Dim myItem As Object
Dim olfolder As Outlook.folder
Dim apptItem As AppointmentItem
Set olfolder = Application.Session.GetDefaultFolder(olFolderCalendar)
For i = olfolder.Items.Count To 1 Step -1
Set myItem = olfolder.Items(i)
If myItem.Class = olAppointment Then
Set apptItem = myItem
'code here
End If
Next
When deleting items it's usually best to start high and iterate backwards. Delete as you go.

Answer 3

I know the request is a bit old, but I wanted to contribute with a code I have written which may help.
Sub CalendarCleanup()
Dim tmpCalendarFolder As Outlook.MAPIFolder
Dim i As Long
Set tmpCalendarFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
' If you want to target a specific folder, you can use this code
'Set tmpCalendarFolder = Application.GetNamespace("MAPI").Folders("YOUR INBOX NAME").Folders("YOUR CALENDAR FOLDER")
'For i = 1 to tmpCalendarFolder.Items.Count Step -1
For i = tmpCalendarFolder.Items.Count to 1 Step -1
tmpCalendarFolder.Items(i).Delete
Next i
End Sub
Please make sure the correct folder is selected (tmpCalendarFolder) before running the code... or at least make some tests before running on a "production" environment, as you are deleting items.
EDIT: code adjusted as per comments below