Getting data from other calendar - vba

Question

Hi i have written the below code to get the appointment from my outlook calendar. the code is working perfectly fine. However i also have another calendar (marked in green) in my outlook & i want to get info from that calendar as well. can please someone modify my code so info from all the calendar
Sub meetingextract()
Dim application As Object: Set application = CreateObject("outlook.application")
dimmynamespace As outlook.Namespace
Dim tdystart As Date
Dim tyend As Date
Dim r As Long
Dim myappointments As outlook.items
Dim currentappointme As outlook.appointmentitem
Set mynamespace = application.getnamespace("mapi")
tdstart = Range("e1").Value
Dim myfol As outlook.folder
setmyfol = mynamespace.getdefaultfolder(olfoldercalener)
Range("a1:d1").Value = Array("subject", "from", "tillwhat", "location")
r = 2
tdyend = Range("f1").Value
Set myappointments = mynamespace.getdefaultfolder(olfoldercalendar).items
myappointments.Sort "[start]"
myappointments.includerecurrences = True
setcurrentappointment = myappointments.find("[start] >= """ & tdystart & """ and [start] <= """ & tdyend & """)
While TypeName(currentappointment) <> "nothing"
Cells(r, 1) = currentappointment.Subject
Cells(r, 2) = currentappointment.Start
Cells(r, 3) = currentappointment.End
Cells(r, 4) = currentappointment.Location
r = r + 1
Set currentappointment = myappointments.FindNext
Wend
End Sub

Answer 1

You can use the NameSpace.GetSharedDefaultFolder method which returns a Folder object that represents the specified default folder for the specified user. This method is used in a delegation scenario, where one user has delegated access to another user for one or more of their default folders (for example, their shared Calendar folder).
Sub ResolveName()
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim CalendarFolder As Outlook.Folder
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Eugene Astafiev")
myRecipient.Resolve
If myRecipient.Resolved Then
Call ShowCalendar(myNamespace, myRecipient)
End If
End Sub
Sub ShowCalendar(myNamespace, myRecipient)
Dim CalendarFolder As Outlook.Folder
Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
CalendarFolder.Display
End Sub
Also you may check out the local folder structure and use the Folders property to get subfolders.