Question

我正在编写一个脚本从sharepoint站点获取数据，并在发生实验室中断时创建Outlook预约。我有一个删除方法，如果我在我的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)将检索您的默认日历文件夹。您需要使用olkSession.GetSharedDefaultFolder(someRecipient, olFolderCalendar)（someRecipient返回olkSession.CreateRecipient)，或者从Namespace.Stores集合打开相应的商店（假设委托邮箱已经存在）并调用{{1} }}

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

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

2 个答案: