Export All appointments and meetings including recurring meetings Excel VBA

Question

I'm currently using the following code to export a list of the weekly meetings and appointments I have:

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

However, the recurring meetings/appointments are not exported when I use the aforementioned code. I looked online for a solution, but all the examples I could find involved scheduling appointments rather than keeping a list of them. Is there a way to include all occurrences in the date range and the recurring appointments in the export list? (1 week).

Answer 1

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.

Only appointments in the Items collection that are not sorted by any other property other than Start in ascending order are affected by this property. False is the default setting. Use this property to retrieve all appointments for a specific date, including recurring appointments that would otherwise not be displayed because they are not tied to a particular day. The following steps must be followed if you need to sort and filter on appointment items that include recurring appointments: Set IncludeRecurrences to True, sort the items in ascending order, and then filter the results. For instance:

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:

• How To: Use Restrict method in Outlook to get calendar items
• How To: Retrieve Outlook calendar items using Find and FindNext methods