Betreff von eingehenden E-Mails automatisch mittels VBA modifizieren


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

, , ,

Dieser Beitrag wurde am Juni 14, 2007, 9:49 am unter Programmierung verfasst. Sie können alle Antworten auf diesen Beitrag nachverfolgen mit RSS 2.0. Sie können eine Antwort, oder einen Trackback von Ihrer eigenen Seite hinterlassen.

  1. Bisher keine Kommentare.
(wird nicht veröffentlicht)