Excel 2010 VBA代码删除所有Outlook约会

Question

I am trying to delete all appointments from an Excel VBA (Excel 2010) macro but get an Error 13 (Type Mismatch) on the olFolder.Items.GetFirst . I can't explain why, since it run flawless a few weeks ago.

Anyone who can give me a hand with this error=

Here´s the VBA code:

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

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 2

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 3

I know the request is a bit old, but I wanted to contribute with a code I have written which may help.

SubSub CalendarCleanup()
  Dim tmpEvent As AppointmentItem
  Dim tmpCalendarFolder As Outlook.MAPIFolder

  Set tmpCalendarFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)

  For Each tmpEvent In tmpCalendarFolder.Items
    tmpEvent.Delete
  Next tmpEvent

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.