CODEWITHSUNDEEP
vbaoutlook
user3726113
user3726113

Reputation: 21

How to delete all appointments?

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

Upvotes: 1

Views: 3625

Answers (3)

Mighty Gorgon
Mighty Gorgon

Reputation: 33

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

Upvotes: 0

Andy G
Andy G

Reputation: 19367

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.

Upvotes: 2

D_Bester
D_Bester

Reputation: 5931

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.

Upvotes: 2

Related Questions