Archive Calendar Items

You can set via folder properties if and when the folder should be archived. Of course, if you like you can also built your own solution. This sample archives all items of the default calendar that have reached a certain age to another folder.

  How to add macros to Outlook

Public Sub ArchivItems()
  Dim SrcFolder As Outlook.MAPIFolder
  Dim DestFolder As Outlook.MAPIFolder
  Dim Items As Outlook.Items
  Dim obj As Object
  Dim Appt As Outlook.AppointmentItem
  Dim Ns As Outlook.NameSpace
  Dim DueDate As Date
  Dim i&
  Dim Counter&

  Set Ns = Application.GetNamespace("MAPI")

  'Select Archive folder
  Set DestFolder = Ns.PickFolder
  If DestFolder Is Nothing Then Exit Sub

  'Set the age, archive if older than 7 days
  DueDate = DateAdd("d", -7, Now)

  'Archive from default calendar
  Set SrcFolder = Ns.GetDefaultFolder(olFolderCalendar)
  Set Items = SrcFolder.Items

  For i = Items.Count To 1 Step -1
    Set obj = Items(i)
    If TypeOf obj Is Outlook.AppointmentItem Then
      Set Appt = obj
      If DateDiff("s", Appt.End, DueDate, vbUseSystemDayOfWeek, vbUseSystem) > 0 Then
        Appt.Move DestFolder
        Counter = Counter + 1
      End If
    End If
  Next

  MsgBox Counter & " items have been moved", vbInformation
End Sub