Applies to Microsoft Outlook 2010, Outlook 2007, Outlook 2003, Outlook 2002
Like the macro that creates copies of each occurrence in a series, this macro gets the dates of each occurrence, printing it to a new message instead of creating appointments.
Using the macro
This macro was tested in Outlook 2010, Outlook 2007 and Outlook 2003. It should work with at least Outlook 2002 as well (it's built off the Outlook 2002 macro listed in More Information).
However, the filter (sFilter) needs to be edited for older versions, as [IsRecurring] does not work. Use this instead:
sFilter = “[Start] >= ’1/1/2000′ And [End] < '" & tEnd & "' And [Subject] = " & strSubject
Also, leading or ending spaces (" My Appointment" or "My Appointment ") in the subject will cause the macro to fail, returning 0 appointments found. Removing the spaces from the subject should take care of it. You could move or copy the recurring appointment to a new Calendar folder and remove the subject filter.
Print a list of all dates in a series
Open the VBA Editor using Alt+F11. Expand the Project to display ThisOutlookSession on the left. Double click to open it and paste the code below into the right side. Select a calendar folder then run the macro.
To use, select a recurring appointment or meeting and run the macro.
I highly recommend using list view when you use this macro.
Sub PrintRecurring() Dim CalFolder As Outlook.MAPIFolder Dim CalItems As Outlook.Items Dim ResItems As Outlook.Items Dim sFilter, strSubject, strOccur As String Dim iNumRestricted As Integer Dim itm, ListAppt As Object Dim tStart, tEnd As Date ' Use the selected calendar folder Set CalFolder = Application.ActiveExplorer.CurrentFolder Set CalItems = CalFolder.Items ' Sort all of the appointments based on the start time CalItems.Sort "[Start]" CalItems.IncludeRecurrences = True ' Set an end date tEnd = Format(Now + 10, "Short Date") strSubject = Application.ActiveExplorer.Selection.Item(1).Subject 'create the Restrict filter by day and recurrence sFilter = "[Start] >= '1/1/2000' And [End] < '" & tEnd & "' And [IsRecurring] = True And [Subject] = " & strSubject Set ResItems = CalItems.Restrict(sFilter) iNumRestricted = 0 'Loop through the items in the collection. For Each itm In ResItems iNumRestricted = iNumRestricted + 1 ' Create list of dates strOccur = strOccur & vbCrLf & itm.Subject & vbTab & " >> " & vbTab & itm.Start & vbTab & " to: " & vbTab & itm.End Next ' After the last occurence is checked ' Open a new email message form and insert the list of dates Set ListAppt = Application.CreateItem(olMailItem) ListAppt.Body = strOccur & vbCrLf & iNumRestricted & " occurrences found." ListAppt.Display Set itm = Nothing Set ListAppt = Nothing Set ResItems = Nothing Set CalItems = Nothing Set CalFolder = Nothing End Sub