Outlook VBA-Script um das Empfangsdatum in den Betreff einzufügen

Ein simples Outlook-VBA Script, welches insbesondere im Zusammenhang mit der täglichen Arbeit mit DMS-Systemen die Arbeit erleichtert. 

Auf Knopfdruck kann hiermit das Empfangsdatum der Mail an den Betreff vorangestellt werden. Dadurch werden die Mails sofern diese zum Beispiel in DMS-Systemen abgelegt werden direkt sortiert ohne, dass das Datum manuell davor geschrieben werden muss. 

Weitere Details, auch zur Einbindung in Outlook, gibt es auf Github unter: https://github.com/nesslinger-it/outlook-vba 

Sub AddDateToSubject()


Dim olFolder As MAPIFolder
Dim olSelection As Selection
Dim olItem As Object
Dim iCountMeetingItems As Integer

Dim olItemCurrentDate As Date

Set olFolder = Application.ActiveExplorer.CurrentFolder

If olFolder.DefaultItemType = olMailItem Then
    Set olSelection = Application.ActiveExplorer.Selection
    
    For Each olItem In olSelection
    
    With olItem
       If TypeOf olItem Is MailItem Then
         olItemCurrentDate = .ReceivedTime
        .Subject = Year(olItemCurrentDate) & "-" & Format(Month(olItemCurrentDate), "00") & "-" & Format(Day(olItemCurrentDate), "00") & " " & .Subject
        .Save
        Else
        'ElseIf TypeOf olItem Is MeetingItem Then --> if you want match MeetingItems
        iCountMeetingItems = iCountMeetingItems + 1
       End If
   
    End With

    Next
    
    If iCountMeetingItems > 0 Then

    MsgBox "Hinweis: Ihre Auswahl enthält: " & CStr(iCountMeetingItems) & " Obejekt(e). Diese können bei der automatischen Umbennenung des Betreffs nicht berücksichtigt werden.", vbInformation
       
    End If
    
End If
End Sub