访问获取共享文件夹会议的子文件夹

时间:2016-08-29 06:03:37

标签: vba ms-access outlook access-vba

我有以下代码可以让我从共享子日历中检索会议,但它不起作用。

如果我只尝试访问主共享日历,它可以完美运行,但不适用于子日历..

有人能以正确的方式指出我吗?

Public Sub getCalendarData(calendar_name As String, sDate As Date, eDate As Date, Optional recurItem As Boolean = True)
    On Error GoTo ErrorHandler

    Dim oOL As Outlook.Application
    Dim oNS As Outlook.Folder
    Dim oAppointments As Outlook.AppointmentItem
    Dim oAppointmentItem As Outlook.AppointmentItem
    Dim strFilter As String
    Dim ItemsCal As Outlook.Items
    Dim olFolder As Outlook.Folder
    Dim fldCalendar As Outlook.Folder
    Dim iCalendar As Integer
    Dim nmsNameSpace As Outlook.Namespace
    Dim objDummy As Outlook.MailItem
    Dim objRecip As Outlook.Recipient

    'Set objects

    Set oOL = CreateObject("Outlook.Application")
    Set nmsNameSpace = oOL.GetNamespace("MAPI")

    Set objDummy = oOL.CreateItem(olMailItem)

    Set objRecip = nmsNameSpace.CreateRecipient("shared calendar name")
    objRecip.Resolve

    'Set filter to grab items by date range
    strFilter = "[Start] >= " _
    & "'" & sDate & "'" _
    & " AND [End] <= " _
    & "'" & eDate & "'"

    With ItemsCal
        .Sort "[Start]"
        .IncludeRecurrences = recurItem
    End With

    If objRecip.Resolved Then
        On Error Resume Next
        Set fldCalendar = nmsNameSpace.GetSharedDefaultFolder(objRecip, olFolderCalendar).Folders("sub_calendar_name")

        If Not fldCalendar Is Nothing Then
            Set ItemsCal = fldCalendar.Items
            If Not ItemsCal Is Nothing Then
                For Each oAppointmentItem In ItemsCal.Restrict(strFilter)
                    Set objItem = oAppointmentItem
                    With oAppointmentItem
                        iCalendar = getSegmentIDByName(calendar_name)
                        meeting_id = insertAppointment(iCalendar, .Start, .End, scrubData(.Subject), scrubData(.Location), Format(.Start, "Long Time"), .duration, .Body)
                        Call GetAttendeeList(meeting_id, objItem, .Recipients)
                    End With
                Next
            End If
        End If
    End If

    'Garbage cleanup
    Set oAppointmentItem = Nothing
    Set oAppoinments = Nothing
    Set oNS = Nothing
    Set oOL = Nothing

Exit Sub
ErrorHandler:
    'MsgBox "Error: " & Err & " | " & Error(Err)
    'Whenever error occurs, skip to next
    Resume Next
End Sub

问题是fldCalendar总是返回nothing而我不知道出了什么问题。

谢谢!

1 个答案:

答案 0 :(得分:2)

请记住,在从其他邮箱访问默认文件夹时,在缓存模式下,您无法访问整个邮箱 - 文件夹(但不包含其子文件夹)会缓存在主OST文件中。

您可以将整个邮箱添加为委派存储(Exchange帐户属性对话框的“高级”选项卡),然后向下钻取到Store.RootFolder(从Namespace.Stores集合中检索存储的文件夹)。

如果使用Redemption是一个选项,则RDOSession的版本。GetSharedDefaultFolder(或RDOSession.GetSharedMailbox)会返回一个实时文件夹(RDOFolder),而不是缓存版本,因此您将能够访问子文件夹。