Export all appointments and meetings, including recurring meetings

I need to export a list of the appointments and meetings that I have every week.

Option Explicit
    
Sub Outlook_calendaritemsexport()
    
    Application.ScreenUpdating = False
    
    Sheet6.Select
    
    'clearing old dates
    Range("A2:E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("G4").Select
    
    Dim FromDateWEEK As Date
    Dim ToDateWEEK As Date
    Dim FromDateDAY As Date
    Dim ToDateDAY As Date
    
    FromDateWEEK = Cells(2, 8).Value
    ToDateWEEK = Cells(2, 9).Value
    
    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
    Set myfol = ons.GetDefaultFolder(olFolderCalendar)
    
    Dim myapt As Outlook.AppointmentItem
    Dim outRecurrencePattern As Object
    
    Range("A1:D1").Value = Array("Subject", "Start", "End", "Project", "Duration (Hrs)")
    R = 1
    
    For Each myapt In myfol.Items
    
        If (myapt.Start >= FromDateWEEK And myapt.Start <= ToDateWEEK) Then
        
            'Loop through recurring events for this appointment
            R = R + 1
            Cells(R, 1).Value = myapt.Subject
            Cells(R, 2).Value = myapt.Start
            Cells(R, 3).Value = myapt.End
            Cells(R, 4).Value = myapt.Categories
            Cells(R, 5).Value = ((myapt.End - myapt.Start) * 1440) / 60
        Else
        End If
    
    Next
    
    Set o = Nothing
    Set ons = Nothing
    Set myfol = Nothing
    Set myapt = Nothing
    
    Application.ScreenUpdating = True
    
End Sub

The code does not export the recurring appointments/meetings.

Online, all the examples I could find were setting up appointments, rather than making a list of them.

Is there a way to include the recurring appointments in the export list and include all occurrences in the date range (1 week).

Solution

However, when I use the code above it does not export the recurring appointments/meetings.

To include recurring appointments you need to set up the Items.IncludeRecurrences property which returns a boolean that indicates True if the Items collection should include recurrence patterns.

This property only has an effect if the Items collection contains appointments and is not sorted by any property other than Start in ascending order. The default value is False. Use this property when you want to retrieve all appointments for a given date, where recurring appointments would not normally appear because they are not associated with any specific date. If you need to sort and filter on appointment items that contain recurring appointments, you must do so in this order: sort the items in ascending order, set IncludeRecurrences to True, and then filter the items. For example:

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

Read more about the Find/FindNext and Restrict methods in the following articles I wrote for the technical blog: