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。