1

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

Hyu22
  • 11
  • 2

1 Answers1

0

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
Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
  • Hello, with your Code every single appointment is listed. But still the export only exports the first recurrent appointment. For example: if i have a daily, and export mo-fr , then only the monday daily-appointment is exported. if i export tue-fr, then only the daily-appointment on tuesday is exported. Is there a way to use your code and export the "currentAppointment" list? – Hyu22 Nov 09 '22 at 23:32