Ich bekomme viele standardisierte E-Mails mit einer Fälligkeitsmeldung im Text (Body) der E-Mails. Um diese E-Mails zu verwalten verschiebe ich sie manuell in einen anderen Ordner. Leider lassen sie sich nicht sinnvoll anhand des Fälligkeitsdatum sortieren, da ihr Betreff nicht dementsprechend aufgebaut ist.
Im Betreff der E-Mails steht:
32043262-Hinweis Fälligkeit bla bla bla
Im Text (Body) der E-Mails steht irgend wo:
Fällig am: 25/7/2007,
Zu beachten ist, dass das Datum beim Tages- und Monatsanteil nicht mit führenden Nullen beginnt d.h. es kann ein Datum der Form T/M/JJJJ und ein Datum der Form TT/MM/JJJJ geben.
Ich möchte nun beim Betreff den Zahlencode “32043262-”, der bei jeder E-Mail ein anderer ist, durch das Datum, welches irgendwo im Text steht, ersetzen.
Die Lösung:
- Dem Betreff müssen am Anfang die 9 Zeichen des Zahlencodes: “32043262-” entfernt werden
- Das Datum der Fälligkeit muss aus dem Text (Body) ausgelesen werden
- Das Datum der Fälligkeit soll dem Betreff in der Form “Faelligkeit : JJJJ.MM.TT -” am Anfang angehängt werden.
Der VBA-Quellcode
Ich habe das Beispiel zum Thema NewMailEx aus der VBA-Hilfe verwendet und dieses angepasst. Hier ist nur der angepasste Teil dokumentiert.
Dieser Code muss in der Sektion ThisOutlookSession eingegeben werden:
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