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 |
Hallo,
das ist ein Super Script nur kenne ich mich leider sehr schlecht mit solchen Scribten aus, wäre es möglich das Sie mir ein Scribt schreiben?
Bei allen eingehenden Mails soll das Aktuelle datum in der Betreffzeile hinzugefügt werden in dieser Form 171025 könnten Sie mir dies bauen? und mir eine Anleitung mitsenden wie ich es zum Laufen bekomme? Vielen dank schon mal für Ihre Antwort
Hallo Jürgen,
danke für deinen Kommentar. Leider übernehme ich keine solchen Aufträge. Sorry.
Grüße
Dietmar