Question

我正在尝试从Excel VBA（Excel 2010）宏中删除所有约会，但在 olFolder.Items.GetFirst 上获得错误13（类型不匹配）。我无法解释为什么，因为几周前它完美无缺。

任何能够帮我解决此错误的人

这是VBA代码：

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

通常这意味着您实际上文件夹中的某些项目不是约会项目。在假定它是预约之前，您需要测试该项目是什么。即使文件夹设置为仅包含约会项目，也是如此。

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

删除项目时，通常最好从高处开始并向后迭代。随你删除。

Answer 2

如前所述，您应该以相反的顺序删除它们 - 因为它们每次都被重新编入索引，并且您最终会尝试引用不存在的项目。

您不需要Set循环中的下一个项目，因为您可以使用Remove(i)删除特定项目：

For i = olItems.Count To 1 Step -1
    If TypeOf olItems(i) Is olApp.AppointmentItem Then
        olItems.Remove (i)
    End If
Next i

但是，此代码将删除每个约会，因为几乎日历中的所有内容都是AppointmentItem。如果您不想删除Meeting，那么您需要阅读一些属性，例如MeetingStatus，会议为1，非会议为0：

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

从Excel可以看出，使用olAppointment可能比AppointmentItem更受欢迎，因为如果需要，您可以替换26的数值：If olItems(i).Class = 26。

Answer 3

我知道请求有些陈旧，但是我想用自己编写的代码有所帮助。

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

在运行代码之前，请确保选择了正确的文件夹（tmpCalendarFolder）...，或者至少要在“生产”环境中运行之前进行一些测试，因为要删除项目。

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

3 个答案: