Listing 1: The PurgeCalendarFolder() Function
NONEXECUTABLE: To obtain the executable file, download the zip file from the opening page of the article.

Function PurgeCalendarFolder(objFolder As MAPIFolder) As String
    Dim colItems As Items
    Dim colOldItems As Items
    Dim objItem As AppointmentItem
    Dim strRes As String
    Dim intCount As Integer
    Dim strRestrict As String
        
    ' make sure this is a Calendar folder
    If objFolder.DefaultItemType = olAppointmentItem Then
        Set colItems = objFolder.Items
        
        ' get all the recurrences
        colItems.Sort "[Start]"
        colItems.IncludeRecurrences = True
        
        ' set optional restriction
        strRestrict = GetRestrictDate(objFolder.Name)
        If strRestrict <> "" Then
            strRestrict = "[End] < " & Chr(34) & _
              Format(strRestrict, "mmm dd, yyyy") & Chr(34)
            Set colOldItems = colItems.Restrict(strRestrict)
        End If
        
        ' perform deletions
        Set objItem = colOldItems.GetFirst
        Do Until objItem Is Nothing
            Debug.Print objItem.End
            objItem.Delete
            intCount = intCount + 1
            Set objItem = colOldItems.GetNext
        Loop
    End If
    
    ' report back to calling procedure
    If intCount > 0 Then
        strRes = Format(intCount) & " items purged"
    Else
        strRes = "no items purged"
    End If
    
    PurgeCalendarFolder = strRes
    
    Set objItem = Nothing
    Set colItems = Nothing
    Set colOldItems = Nothing
End Function