Zugang Get Unterordner von freigegebenen Ordnern

Question

Ich versuche, die Treffen von einem Ausblick gemeinsamen Unter Ordnern zu bekommen, aber ich habe keine Ahnung, warum der folgende Code nicht funktioniert ..

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 

Wenn ich es verwende nur Set fldCalendar = nmsNameSpace.GetSharedDefaultFolder(objRecip, olFolderCalendar) gibt mir die freigegebenen Kalenderelemente, aber nicht die Unterordner Kalenderelemente

Könnte mir jemand durch mich zeigen?

Vielen Dank!

Answer 1

Fix folgende Set objRecip = objDummy.Recipients.Add("shared calendar name") Um Set objRecip = nmsNameSpace.CreateRecipient("Owner's Name or email address") sehen, ob das hilft