Public Sub InsertDate()

    '=====================================================================
    ' Fügt an den Anfang des Betreffs der markierten Elemente das Datum ein.
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-09 - Version 1.0.0
    ' 2008-11-21 - Version 1.0.1
    ' 2010-11-17 - Version 1.1.0
    ' 2013-03-01 - Version 2.0.0
    '=====================================================================
   
    Dim objSelection As Outlook.Selection ' Alle ausgewählten Elemente
    Dim objItem As Object                 ' Aktuell geöffnetes Element
   
    '---------------------------------------------------------------------
    ' Fehlerbehandlung wegen Set-Anweisungen ausschalten
    '---------------------------------------------------------------------
    On Error Resume Next

    '---------------------------------------------------------------------
    ' Aktuell geöffnetes Element refernzieren
    '---------------------------------------------------------------------
    Set objItem = Outlook.ActiveInspector.CurrentItem

    '---------------------------------------------------------------------
    ' Wenn kein Element geöffnet ist, dann markierte Elemente verwenden
    '---------------------------------------------------------------------
    If objItem Is Nothing Then

        '-----------------------------------------------------------------
        ' Aktuelle Auswahl ermitteln
        '-----------------------------------------------------------------
        Set objSelection = Outlook.ActiveExplorer.Selection

        '-----------------------------------------------------------------
        ' Auch nichts markiert?
        '-----------------------------------------------------------------
        If objSelection.Count = 0 Then GoTo ExitProc

        '-----------------------------------------------------------------
        ' Markierte Elemente bearbeiten
        '-----------------------------------------------------------------
        For Each objItem In objSelection

            '-------------------------------------------------------------
            ' Datum einfügen
            '-------------------------------------------------------------
            Call AddDate(objItem)

        Next

    Else

        '-----------------------------------------------------------------
        ' Datum einfügen
        '-----------------------------------------------------------------
        Call AddDate(objItem)

    End If

ExitProc:

    '---------------------------------------------------------------------
    ' Referenz auf Objekte löschen
    '---------------------------------------------------------------------
    Set objItem = Nothing
    Set objSelection = Nothing

End Sub

Private Sub AddDate(ByVal objItem As Object)