Ablaufdatum für Email festlegen

Wir bekommen täglich viele E-Mails, die nur für eine bestimmte Zeit aufbewahrt werden sollen und dann gelöscht werden können. Damit Sie die E-Mails nicht immer wieder lesen müssen, um zu bestimmen, ob Sie nun gelöscht werden kann, gibt es in Outlook die Möglichkeit, jede Nachricht mit einem Ablaufdatum zu versehen. Wenn das Datum erreicht ist, stellt Outlook diese durchgestrichen dar. So sehen Sie auf einen Blick, was gelöscht werden kann (das kann sogar automatisiert werden).

Dieses Beispiel zeigt, wie Sie das Datum mit nur zwei Klicks entweder für eine geöffnete Nachricht oder für alle in einem Ordner selektierten Nachrichten festlegen können. Über einen Dialog werden Sie gefragt, in wieviel Wochen (ab heute) die Nachricht ablaufen soll. Wenn Sie eine 0 eingeben, dann wird das Ablaufdatum gelöscht, bei negativen Zahlen wird die Nachricht sofort als abgelaufen dargestellt.

  So fügen Sie Makros in Outlook ein

Public Sub SetExpiryTime()
  Dim Sel As Outlook.Selection
  Dim obj As Object
  Dim Interval As Long
  Dim ExpiryTime As Date
  Dim Text$

  If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
    Set obj = Application.ActiveInspector.CurrentItem

  Else
    Set Sel = Application.ActiveExplorer.Selection
    If Sel.Count = 0 Then
      Exit Sub
    Else
      Set obj = Sel(1)
    End If
  End If

  Select Case True
  Case (TypeOf obj Is Outlook.MailItem), _
    (TypeOf obj Is Outlook.MeetingItem), _
    (TypeOf obj Is Outlook.PostItem)

    ExpiryTime = obj.ExpiryTime
  End Select

  If ExpiryTime = #1/1/4501# Then
    Text = "-"
  Else
    Text = ExpiryTime
  End If

  Text = "Aktuelles Ablaufdatum: " & Text & vbCrLf & vbCrLf
  Text = Text & "In wieviel Wochen soll die Auswahl ablaufen?"
  Text = InputBox(Text, , "8")

  If Len(Text) Then
    Interval = Val(Text)

    If Interval Then
      ExpiryTime = DateAdd("ww", Interval, Date)
    Else
      ExpiryTime = #1/1/4501#
    End If

    If Not Sel Is Nothing Then
      For Each obj In Sel

        Select Case True
        Case (TypeOf obj Is Outlook.MailItem), _
          (TypeOf obj Is Outlook.MeetingItem), _
          (TypeOf obj Is Outlook.PostItem)

          obj.ExpiryTime = ExpiryTime
          obj.Save
        End Select
      Next

    Else
      Select Case True
      Case (TypeOf obj Is Outlook.MailItem), _
        (TypeOf obj Is Outlook.MeetingItem), _
        (TypeOf obj Is Outlook.PostItem)

        obj.ExpiryTime = ExpiryTime
        obj.Save
      End Select
    End If
  End If
End Sub