Sub OutlookCalendarItemsExport()
Dim o As Outlook.Application, R As Long
Set o = New Outlook.Application
Dim ons As Outlook.Namespace
Set ons = o.GetNamespace("MAPI")
Dim myfol As Outlook.Folder
Dim calname As String
calname = Worksheets("Daten").Range("I2").Value
Set myfol = Session.GetDefaultFolder(olFolderCalendar).Folders("Ferien 2021")
Dim myapt As Outlook.AppointmentItem
Worksheets("Daten").Range("h4:j4").Value = Array("Betreff", "Beginn", "Ende")
R = 5
For Each myapt In myfol.Items
Cells(R, 8).Value = myapt.Subject
Cells(R, 9).Value = myapt.Start
Cells(R, 10).Value = myapt.End
R = R + 1
Next
Set o = Nothing
Set ons = Nothing
Set myfol = Nothing
Set myapt = Nothing
End Sub