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

Question

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

任何人谁可以给我个忙错误=

Here's 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。