从共享的 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

我就是这样做的。

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

Answer 2

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