Accessing Appointments and Recurring Appointments in Excel VBA

The following program lists all appointments and recurring appointment masters with the subject « Test »:

Sub AccessAppointments()
    Dim appOutlook As Outlook.Application
    Dim ns As Outlook.Namespace
    Dim folder As Outlook.Folder
    Dim item As Object
    Dim pattern As Outlook.RecurrencePattern
    Dim recurrenceTypeText As String
    Dim dayOfWeekList As String
    Dim output As String
    Set appOutlook = CreateObject("Outlook.Application")
    ' Get MAPI namespace and default calendar folder
    Set ns = appOutlook.GetNamespace("MAPI")
    Set folder = ns.GetDefaultFolder(olFolderCalendar)
    ' Loop through all items in the calendar folder
    For Each item In folder.Items
        If TypeOf item Is Outlook.AppointmentItem Then
            If item.Subject = "Test" Then
                output = output & item.Start & " " & _
                    item.Duration & " " & item.Subject & " " & _
                    item.Location
                ' Check if item is the master of a recurring series
                If item.RecurrenceState = olApptMaster Then
                    Set pattern = item.GetRecurrencePattern
                    ' Determine recurrence type text
                    Select Case pattern.RecurrenceType
                        Case olRecursWeekly
                            recurrenceTypeText = "Weekly"
                        Case olRecursDaily
                            recurrenceTypeText = "Daily"
                        Case olRecursMonthly
                            recurrenceTypeText = "Monthly"
                        Case olRecursYearly
                            recurrenceTypeText = "Yearly"
                        Case Else
                            recurrenceTypeText = "Other"
                    End Select
                    ' Get list of days for weekly recurrence
                    dayOfWeekList = GetDayOfWeekList(pattern.DayOfWeekMask)
                    output = output & " Series " & recurrenceTypeText & " " & _
                        dayOfWeekList & vbCrLf & _
                        " From: " & pattern.PatternStartDate & _
                        " to: " & pattern.PatternEndDate
                End If
                output = output & vbCrLf
            End If
        End If
    Next item
    MsgBox output
    appOutlook.Quit
    Set pattern = Nothing
    Set item = Nothing
    Set folder = Nothing
    Set ns = Nothing
    Set appOutlook = Nothing
End Sub
Function GetDayOfWeekList(mask As Integer) As String
    If (mask And olSunday) > 0 Then GetDayOfWeekList = GetDayOfWeekList & "Sun "
    If (mask And olMonday) > 0 Then GetDayOfWeekList = GetDayOfWeekList & "Mon "
    If (mask And olTuesday) > 0 Then GetDayOfWeekList = GetDayOfWeekList & "Tue "
    If (mask And olWednesday) > 0 Then GetDayOfWeekList = GetDayOfWeekList & "Wed "
    If (mask And olThursday) > 0 Then GetDayOfWeekList = GetDayOfWeekList & "Thu "
    If (mask And olFriday) > 0 Then GetDayOfWeekList = GetDayOfWeekList & "Fri "
    If (mask And olSaturday) > 0 Then GetDayOfWeekList = GetDayOfWeekList & "Sat "
End Function

Explanation:

• The default calendar folder (olFolderCalendar) is accessed via the MAPI namespace.
• Items in this folder are of type AppointmentItem, which have properties such as Start, Duration, Subject, and Location.
• The program loops through all items and selects those with the subject « Test. »
• If the item’s RecurrenceState equals olApptMaster, it is the master appointment of a recurring series.
• The recurring pattern object (RecurrencePattern) is obtained using GetRecurrencePattern.
• The RecurrenceType property indicates the recurrence frequency, such as weekly, daily, monthly, or yearly.
• The DayOfWeekMask is decoded into a readable list of days using the helper function GetDayOfWeekList, which tests each weekday flag using bitwise And.
• The start and end dates of the recurrence pattern are also displayed.