Access Get вложенного общей папки

Question

Я пытаюсь получить встречи из подпапки прогноза общих, но я понятия не имею, почему следующий код не работает ..

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") увидеть, если это помогает