VBA - Download shared calendar from Outlook.

[BenGee]

Hi - I have the below code which successfully downloads my own calendar from Outlook, however, is there a way to tweak this to specify a particular calendar. This calendar is a shared calendar called "Team Calendar".


Thanks in advance

Sub Button1_Click()

    Dim olApp As Object
    Dim olNS As Object
    Dim olFolder As Object
    Dim olApt As Object
    Dim NextRow As Long
    Start1 = ActiveSheet.Range("A1")
    End1 = ActiveSheet.Range("B1")
     
    Set olApp = CreateObject("Outlook.Application")
     
    Set olNS = olApp.GetNamespace("MAPI")
     
    Set olFolder = olNS.GetDefaultFolder(9) 'olFolderCalendar
     
    Worksheets("Data").Range("A1:D1").Value = Array("Subject", "Start", "End", "Location")
     
    NextRow = 2
     
    For Each olApt In olFolder.Items
        'If olApt.Start >= Start1 And olApt.End <= End1 Then
        Worksheets("Data").Cells(NextRow, "A").Value = olApt.Subject
        Worksheets("Data").Cells(NextRow, "B").Value = olApt.Start
        Worksheets("Data").Cells(NextRow, "C").Value = olApt.End
        Worksheets("Data").Cells(NextRow, "D").Value = olApt.Location
        NextRow = NextRow + 1
        'End If
    Next olApt
     
    Set olApt = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
     
    Worksheets("Data").Columns.AutoFit

End Sub