Question

我正在尝试从outlook共享子文件夹中获取会议，但我不知道为什么下面的代码无效..

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 = objDummy.Recipients.Add("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

如果我只使用Set fldCalendar = nmsNameSpace.GetSharedDefaultFolder(objRecip, olFolderCalendar)，它会为我提供共享日历项目，但不会提供子文件夹日历项目

有人能指点我吗？

谢谢！

Answer 1

修复以下Set objRecip = objDummy.Recipients.Add("shared calendar name")至Set objRecip = nmsNameSpace.CreateRecipient("Owner's Name or email address")，看看是否有帮助

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

1 个答案: