Export Outlook-Calendar with recurring meetings with VBA Macro - vba

Question

I created a VBA-macro to send my Outlook-calendar from my Work-account to my private Mail to import the appointments to my private calendar.
Now i realised that only the first appointment of a recurring appointment is exported.
Only if i use this configuration, all appointments are exported:
CalendarDetail = olFreeBusyOnly
Is there a way to export all appointments including the recurrences, but using "olFreeBusyAndSubject" or "olFullDetails" as setting?
I used this code:
Sub CalenderExport()
Dim ol As Outlook.Application
Dim cal As Folder
Dim exporter As CalendarSharing
Dim FirstDayInMonth, LastDayInMonth As Variant
Dim dtmDate As Date
Dim mi As MailItem
dtmDate = Date
FirstDayInMonth = DateSerial(Year(Date), Month(Date), 0)
LastDayInMonth = DateSerial(Year(Date), Month(Date) + 1, 0)
Set ol = Application
Set cal = ol.Session.GetDefaultFolder(olFolderCalendar)
Set exporter = cal.GetCalendarExporter
With exporter
.CalendarDetail = olFullDetails
.IncludeAttachments = False
.IncludePrivateDetails = False
.RestrictToWorkingHours = False
.IncludeWholeCalendar = False
.StartDate = FirstDayInMonth
.EndDate = LastDayInMonth
Set mi = .ForwardAsICal(olCalendarMailFormatEventList)
End With
With mi
.Body = "Kalenderexport"
.To = "my_mail#live.de"
.Subject = Date & " " & Time & " Calendar"
.Send
End With
End Sub
And this site for reference:
https://learn.microsoft.com/de-de/office/vba/api/outlook.calendarsharing.calendardetail
Thanks in advance

Answer 1

The code looks good, I don't see anything suspicious.
But to make sure that everything is exported correctly you may try to get all items for a specific date range by using the Find/FindNext or Restrict methods of the Items class. So, try to run the following code sample and then compare the results:
Sub DemoFindNext()
Dim myNameSpace As Outlook.NameSpace
Dim tdystart As Date
Dim tdyend As Date
Dim myAppointments As Outlook.Items
Dim currentAppointment As Outlook.AppointmentItem
Set myNameSpace = Application.GetNamespace("MAPI")
tdystart = VBA.Format(Now, "Short Date")
tdyend = VBA.Format(Now + 1, "Short Date")
Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
myAppointments.Sort "[Start]"
myAppointments.IncludeRecurrences = True
Set currentAppointment = myAppointments.Find("[Start] >= """ & _
tdystart & """ and [Start] <= """ & tdyend & """")
While TypeName(currentAppointment) <> "Nothing"
MsgBox currentAppointment.Subject
Set currentAppointment = myAppointments.FindNext
Wend
End Sub