List Outlook Calendar Appointments

Once again, here is a simple procedure (based on a database I created many a moons ago) to extract a listing of appointments from your Outlook Calendar that I created to help someone in a forum. I thought the code could help others.

'---------------------------------------------------------------------------------------
' Procedure : GetFutureOutlookEvents
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Generate a listing of future appointments from your Outlook Calendar
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
' Req'd Refs: None
'
' Usage:
' ~~~~~~
' Call GetFutureOutlookEvents
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2016-09-08              Initial Release
'---------------------------------------------------------------------------------------
Sub GetFutureOutlookEvents()
    Dim oOutlook              As Object
    Dim oNS                   As Object
    Dim oAppointments         As Object
    Dim oFilterAppointments   As Object
    Dim oAppointmentItem      As Object
    Dim bOutlookOpened        As Boolean
    Dim i                     As Long
    Const olFolderCalendar = 9

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")    'Bind to existing instance of Outlook
    If Err.Number <> 0 Then    'Could not get instance of Outlook, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
        bOutlookOpened = False    'Outlook was not already running, we had to start it
    Else
        bOutlookOpened = True    'Outlook was already running
    End If
    On Error GoTo Error_Handler
    DoEvents

    Set oNS = oOutlook.GetNamespace("MAPI")
    Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)
    'Apply a filter so we don't waste our time going through old stuff if we don't need to.
    sFilter = "[Start] > '" & Date & "'"
    Set oFilterAppointments = oAppointments.Items.Restrict(sFilter)
    Debug.Print oFilterAppointments.Count & " appointments found."
    'Iterate through each appt in our calendar
    For Each oAppointmentItem In oFilterAppointments
        Debug.Print oAppointmentItem.Subject, oAppointmentItem.Start, oAppointmentItem.End
    Next

    If bOutlookOpened = False Then    'Since we started Outlook, we should close it now that we're done
        oOutlook.Quit 'There seems to be a delay in this action taking place, but does eventually take place
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oAppointmentItem = Nothing
    Set oFilterAppointments = Nothing
    Set oAppointments = Nothing
    Set oNS = Nothing
    Set oOutlook = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetFutureOutlookEvents" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

The above procedure uses a Items.Restrict Method to only list future appointments based on the current date. I did this just to demonstrate the ease with which you could extract specific details depending on your needs. Obviously, this can be modified, or eliminated depending on your needs.

This procedure also use Late Binding technics so no reference libraries are required, it is a simple plug & play procedure. Furthermore, it is not Access specific. This procedure could be run from Access, Word, Excel, or any other VBA platform.

4 responses on “List Outlook Calendar Appointments

  1. Robert Wardlow

    Daniel: Great code! Have you ever had to do something similar with MS Project? Extract dates and pull into Access?

    1. Daniel Pineault Post author

      No, I haven’t really played with Project since my University days. None of my previous employers or clients have ever used it so I just haven’t has any need to do so.

  2. Teis Melcher

    Hey Daniel
    I have used your code and have a little problem. I don’t get recurrence appointments in the same search? Otherwise it works all right.

  3. Babul

    Hi Daniel,
    How would you set the sFilter so that all schedules between date x and date y is captured?
    Thank you.