CODEWITHSUNDEEP
vbaoutlook
rosuandreimihai
rosuandreimihai

Reputation: 656

Access Get subfolder of shared folder

I am trying to get the meetings from an outlook shared sub folder, but I have no idea why the code below is not working..

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

If I only use Set fldCalendar = nmsNameSpace.GetSharedDefaultFolder(objRecip, olFolderCalendar) it will give me the shared calendar items, but not the subfolder calendar items

Could someone point me trough?

Thank you!

Upvotes: 1

Views: 574

Answers (1)

0m3r
0m3r

Reputation: 12499

Fix the following Set objRecip = objDummy.Recipients.Add("shared calendar name") To Set objRecip = nmsNameSpace.CreateRecipient("Owner's Name or email address") see if that helps

Upvotes: 1

Related Questions