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:

1. Dem Betreff müssen am Anfang die 9 Zeichen des Zahlencodes: “32043262-” entfernt werden
2. Das Datum der Fälligkeit muss aus dem Text (Body) ausgelesen werden
3. 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

Der Beitrag wurde am Donnerstag, den 14. Juni 2007 um 09:49 Uhr veröffentlicht und wurde unter Programmierung abgelegt. Du kannst die Kommentare zu diesen Eintrag durch den RSS 2.0 Feed verfolgen. Du kannst einen Kommentar schreiben, oder einen Trackback auf deiner Seite einrichten.