Public WithEvents outApp As Outlook.Application
Sub Intialize_Handler()
Set outApp = Outlook.Application
End Sub
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim mai As Object
Dim intInitial As Integer
Dim intFinal As Integer
Dim strEntryId As String
Dim intLength As Integer
Dim PositionDatum As Integer
Dim Faelligkeit As Variant
intInitial = 1
intLength = Len(EntryIDCollection)
intFinal = InStr(intInitial, EntryIDCollection, ",")
Do While intFinal <> 0
strEntryId = Strings.Mid(EntryIDCollection, intInitial, (intFinal - intInitial))
Set mai = Application.Session.GetItemFromID(strEntryId)
intInitial = intFinal + 1
intFinal = InStr(intInitial, EntryIDCollection, ",")
Loop
strEntryId = Strings.Mid(EntryIDCollection, intInitial, (intLength - intInitial) + 1)
Set mai = Application.Session.GetItemFromID(strEntryId)
If (InStr(mai.Subject, "Hinweis Fälligkeit") > 0) Then 'Nur E-Mails mit Hinweis Fälligkeit im Betreff bearbeiten
mai.Subject = Right(mai.Subject, Len(mai.Subject) - 9) 'Die ersten 9 Zeichen des Betreffs wegschneiden
PositionDatum = InStr(mai.Body, "Fällig am: ") 'Position des Datums anhand Zeichenkette suchen
PositionDatum = PositionDatum + 11 'Position auf das erste Zeichen des Datums setzten also 11 Zeichen weiter wie "Fällig am: "
If (PositionDatum > 0) Then
Faelligkeit = Split(Trim(Replace(Mid(mai.Body, PositionDatum, 10), ",", "")), "/") '10 Zeichen auslesen, den eventuell vorhandenen "," löschen und das Datum anhand des Trennzeichens / aufsplitten
If (Len(Faelligkeit(1)) = 1) Then
Faelligkeit(1) = "0" & Faelligkeit(1) 'wenn der Monatsanteil einstellig ist, dann mit einer führenden 0 ergänzen
End If
If (Len(Faelligkeit(2)) = 1) Then
Faelligkeit(2) = "0" & Faelligkeit(2)'wenn der Tagesanteil einstellig ist, dann mit einer führenden 0 ergänzen
End If
mai.Subject = "Fälligkeit: " & Faelligkeit(2) & "." & Faelligkeit(1) & "." & Faelligkeit(0) & "-" & mai.Subject 'neuen Betreff zusammenbauen
End If
mai.Save
End If
End Sub