Datum vor den Betreff einer E-Mail einfügen

Mit diesem Code können Sie per Mausklick das aktuelle Datum oder das Empfangsdatum vor den Betreff einer E-Mail oder eines anderen Outlook®-Elements anfügen.

Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden. Den Code bitte in ein neues Modul kopieren (Einfügen -> Modul im VBA-Editor).

Ab Outlook® 2000

Option Explicit
 
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)
 
    '=====================================================================
    ' Fügt an den Anfang des Betreffs eines Elements das Datum ein.
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2013-03-01 - Version 1.0.0
    '=====================================================================
    
    Dim strDate As String     ' Datum
    Dim blnDate As Boolean    ' Aktuelles Datum oder Empfangsdatum verwenden
    Dim blnReplace As Boolean ' Eventuell vorhandenes Datum ersetzen
    
    '---------------------------------------------------------------------
    ' Fehlerbehandlung ReceivedTime ausschalten
    '---------------------------------------------------------------------
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Soll das aktuelle Datum verwendet werden?
    ' True = Aktuelles Datum verwenden
    ' False = Empfangsdatum verwenden
    '---------------------------------------------------------------------
    blnDate = True
 
    '---------------------------------------------------------------------
    ' Vorhandenes Datum ersetzen?
    ' True = Ja
    ' False = Nein
    '---------------------------------------------------------------------
    blnReplace = False
 
    '---------------------------------------------------------------------
    ' Mit dem Formatbefehl wird das Datum maschinell sortierbar
    '---------------------------------------------------------------------
    If blnDate Then
        strDate = Format(Date, "yyyy-MM-dd")
    Else
        strDate = Format(objItem.ReceivedTime, "yyyy-MM-dd")
    End If
 
    '---------------------------------------------------------------------
    ' Datum schon vorhanden?
    '---------------------------------------------------------------------
    If IsDate(Left(objItem.Subject, Len(strDate))) Then
        If blnReplace Then
            objItem.Subject = strDate & " " & Mid(objItem.Subject, Len(strDate) + 2)
        End If
    Else
        objItem.Subject = strDate & " " & objItem.Subject
    End If
 
    '---------------------------------------------------------------------
    ' Änderung speichern
    '---------------------------------------------------------------------
    If Not objItem.Saved Then objItem.Save
 
    '---------------------------------------------------------------------
    ' Referenz auf Element löschen
    '---------------------------------------------------------------------
    Set objItem = Nothing
 
End Sub