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:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 |
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 |