从共享的Outlook日历中删除约会

Question

我想清除共享日历。

我有一个可以在Outlook日历中使用的删除方法，但是它不能清除共享日历。

Private Sub DeleteAllAppointments()
    Dim olkApp As Object, _
        olkSession As Object, _
        olkCalendar As Object, _
        olkItem As Object, _
        intIndex As Integer
    Set olkApp = CreateObject("Outlook.Application")
    Set olkSession = olkApp.Session
    olkSession.Logon

    Set olkCalendar = olkSession.GetDefaultFolder(olFolderCalendar)
    For intIndex = olkCalendar.Items.Count To 1 Step -1
        Set olkItem = olkCalendar.Items.Item(intIndex)
        olkItem.Delete
    Next
    Set olkItem = Nothing
    Set olkCalendar = Nothing
    olkSession.Logoff
    Set olkSession = Nothing
    Set olkApp = Nothing
End Sub

这是方法失败的地方

Set olkCalendar = olkSession.GetDefaultFolder(olFolderCalendar)

这是文件夹路径问题吗？

Answer 1

olkSession.GetDefaultFolder(olFolderCalendar)将检索默认的Calendar文件夹。 您需要使用olkSession.GetSharedDefaultFolder(someRecipient, olFolderCalendar) （其中someRecipient返回olkSession.CreateRecipient)或者从Namespace.Stores集合中打开相应的存储（假设委托邮箱已经存在）并调用Store.GetDefaultFolder 。

Answer 2

这就是我做的。

Sub Delete_SharedCal_History()
    DeleteCal_Appts "Office Calendar", "1/9/2001", "0:00:01", "12/31/2013", "23:59:59"
End Sub

Sub DeleteCal_Appts(sCalendarName As String, ap_dateStart As String, ap_startTime As String, ap_dateEnd As String, ap_endTime As String)
'   Specified Shared Calendar - Delete all events in specified Date Range
'   Author: Frank Zakikian
    Dim objAppointment As AppointmentItem
    Dim objAppointments As Items
    Dim objNameSpace As NameSpace
    Dim objRecip As Recipient
    Dim nInc As Integer
    Dim sFilter As Variant
    Dim dtStartTime As Date, dtEndTime As Date
    dtStartTime = CDate(ap_dateStart & " " & ap_timeStart)
    dtEndTime = CDate(ap_dateEnd & " " & ap_timeEnd)

    Set objNameSpace = Application.GetNamespace("MAPI")
    'next line would be for use of personal calendar object..
    'Set objAppointments = objNameSpace.GetDefaultFolder(olFolderCalendar)
    Set objRecip = objNameSpace.CreateRecipient(sCalendarName)
    objRecip.Resolve
    'Debug.Print objRec.AddressEntry
    Set objAppointments = objNameSpace.GetSharedDefaultFolder(objNameSpace.CreateRecipient("Akron Chambers Calendar"), olFolderCalendar).Items

    sFilter = "[Start] > '" & Format(dtStartTime, "ddddd h:nn AMPM") & _
      "' And [Start] < '" & Format(dtEndTime, "ddddd h:nn AMPM") & "'"
    objAppointments.Sort "[Start]", False
    Debug.Print "Total Items at begin: " & objAppointments.Count 'dev. fyi
    Set objAppointment = objAppointments.Find(sFilter)
    While TypeName(objAppointment) <> "Nothing"
        'If MsgBox(objAppointment.Subject & vbCrLf & "Delete " & objRec.AddressEntry & " item now? ", vbYesNo, "Delete Calendar Item") = vbYes Then
            objAppointment.Delete
            nInc = nInc + 1
        'End If
        Set objAppointment = objAppointments.FindNext
    Wend
    MsgBox "Deleted " & nInc & " calendar items.", vbInformation, "Delete done"
    Debug.Print "Total Items at finish: " & objAppointments.Count 'dev. fyi
    Set objAppointment = Nothing
    Set objAppointments = Nothing
End Sub