Kalender archivieren

Über Ordnereigenschaften können Sie festlegen, ob und in welchen Intervallen ein Ordner archiviert werden soll. Wer Spaß daran hat, kann das aber natürlich auch per Code selbst machen. Dieses Beispiel archiviert alle Einträge des Standardkalenders, deren Ende ein gewisses Alter erreicht haben, in einen zu wählenden Ordner.

  So fügen Sie Makros in Outlook ein

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")

  'Archivordner wählen
  Set DestFolder = Ns.PickFolder
  If DestFolder Is Nothing Then Exit Sub

  'Altersgrenze festlegen: Archivieren, wenn älter als 7 Tage
  DueDate = DateAdd("d", -7, Now)

  'Standardkalender archivieren
  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 "Es wurde(n) " & Counter & " Element(e) verschoben.", vbInformation
End Sub