Mail to Excel - autom. Auswertung von Mails in MS-Outlook Anhand eines Beispiels möchten wir Ihnen mit diesem Workshop zeigen, wie man eingehende Mails in MS-Outlook via VBA-Makro analysiert, Inhalte ausliest und diese in eine Excel-Datei exportiert.
Autor:  Thomas Friedrichs	Bewertung:     [ Jetzt bewerten ]	Views:  33.958

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 10 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Als Beispiel nehmen wir die autom. Mailbenachrichtung von  chessmail, die man beim Online-Schachspiel zugeschickt bekommt, wenn das Spiel beendet wurde. Die Mails von chessmail sollen via VBA-Makro ausgewertet und das Ergebnis in eine Excel-Datei eingetragen werden.

Abb.: Mailbenachrichtung von chessmail

Abb.: Auswertung in Excel

In Outlook ist einiges etwas anders als in den übrigen Office Anwendungen. Im Gegensatz zu Winword, Excel oder Power Point bietet Outlook keine Möglichkeit, Visual Basic Code einfach aufzuzeichen. Außerdem speichert Outlook den Code in einer extra Datei VBAProject.OTM (diese Datei sicher ich mir regelmäßig!).

Das Visual Basic Fenster ist jedoch bei allen Microsoft Office Anwendungen gleich. Es wird entweder über das Menü (Tools / Marco / Visual Basic Editor), oder über die Tastenkombination ALT+F11 geöffnet. Zu Beginn hat es nur ein Modul. Dieses Modul heißt DieseOutlookSitzung (engl.: ThisOutlookSession).

Bevor wir irgend etwas programmieren, öffnen wir im Visual Basic Fenster über "Extras / Optionen" einen Dialog, in dem wir auf der Registerkarte "Editor" den Punkt "Variablendeklaration erforderlich" auswählen. Ohne diese Auswahl werden Schreibfehler bei der Eingabe von Code nicht als Schreibfehler, sondern als neue Variable gedeuted. Das macht die Suche von Fehlern im Programm extrem schwer. Wenn diese Option eingestellt ist, steht am Kopf eines jeden Moduls "Option Explicit".

Ich habe die Erfahrung gemacht, dass es praktischer ist, dem Modul "DieseOutlookSitzung" weitere Module hinzuzufügen, um den Code übersichtlicher zu organisieren. Über das Menü "Insert Modul" empfehle ich für dieses Projekt anfangs zwei neue Module einzufügen, denen ich im Eigenschaftenfenster (Properties) - kann über F4 angezeigt werden - entsprechende Namen gebe. Wir wählen die Modul-Namen: GL für "globale Deklarierungen" und MN für das "Hauptprogramm (Main)". Zur Übersicht der existierenden Module öffnen wir das Projektfenster (Project Explorer) mit Strg+R.

Nun der erste Code.
Im Modul MN legen wir folgende drei Zeilen an, die ich später erkläre:

Option Explicit 	' Das sollte das Visual Basic Fenster alleine schreiben!
 
' Im Modul MN (Main)
Sub neue_mail(sID As String)
  ' Diese Zeilen sollen später noch erweitert werden.
  Msgbox sID
End Sub

Aufgerufen werden soll unser Code jedes Mal dann, wenn eine neue Mail eintrifft. Dazu stellt Outlook zwei Ereignisse im Modul "DieseOutlookSitzung" bereit. Wir öffnen das Modul "DieseOutlookSitzung" zum Beispiel durch anklicken im Projekt Explorer. Nur im Modul "DieseOutlookSitzung" gibt es in der DropDown-Liste oben links neben (General) noch das Schlüsselwort Application. Wenn wir dieses Wort ausgewählt haben, können wir in der DropDown-Liste oben rechts verschiedene Ereignisse sehen und auswählen. Für unseren Zweck wählen wir NewMailEx, da dieses Ereignis im Gegensatz zu NewMail auch die neue Mail selber identifiziert. Es entsteht ein Code, den wir durch den Aufruf für unseren Code im Modul "MN" ergänzen:

' Im Modul DieseOutlookSitzung (ThisOutlookSession)
 
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
  Call MN.neue_mail(EntryIDCollection)    
End Sub

Wenn jetzt eine neue Mail eintrifft, wird automatisch das Ereignis NewMailEx ausgelöst und der Prozedur MN.neue_mail wird die eindeutige EntryIDCollection übergeben. Dieser Schlüssel wird dort angezeigt. Er ist allerdings nur ein wirrer Text aus Ziffern und Buchstaben. Diesen Schlüssel müssen wir in ein MailItem-Object umwandeln.

Um den Schlüssel in ein MailItem zu verwandeln benötigen wir den Outlook.NameSpace. Für das NameSpace-Objekt halte ich eine globale Variable für sinnvoll. Daher schreiben wir in des Modul GL:

' Im Modul GL (GLOBAL)
 
Global NS As Outlook.NameSpace
Global Stmp As String           ' * allgemeine Variable für Texte
 
Sub set_namespace
  Set NS = Outlook.GetNamespace("MAPI")
End sub

Jetzt basteln wir den Code im Modul MN (Main) weiter.

Das nächste Beispiel zeigt folgende Erweiterungen:

1. Deklaration für ein MailItem
2. Sicherstellen, dass das NameSpace-Objekt existiert
3. Zuweisung des MailItems

Die Zeile "Msgbox sID" ersetzen wir durch "Msgbox mIt.Subject". Sie dient nur zum Testen und fällt später ganz weg.

' Im Modul MN (Main)
 
Sub neue_mail(sID As String)
  Dim mIt As Outlook.MailItem 	' 1)
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Deklration
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If NS Is Nothing Then GL.set_namespace 	' 2)
  Stmp = TypeName(NS.GetItemFromID(sID))
  If Stmp = "MailItem" Then
    Set mIt = NS.GetItemFromID(sID) 	' 3)
  Else
    MsgBox "Die neue Mail ist vom unerwarteten Typ " & vbLf & Stmp & vbLf & _
      " und kann mit dem existierenden Makro nicht verarbeitet werden.", _
      vbCritical, "Abbruch"
    Exit Sub
  End If
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 1 - Die Mail ist identifiziert
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' MsgBox mIt.Subject 	' Msgbox sID
End Sub

Gut, jetzt haben wir die Mail im Objekt mIt und der Punkt ist erreicht, an dem der Inhalt der Mail ausgewertet werden muss. Diese Auswertung muss ganz individuell erfolgen, da sie vom jeweiligen Einsatzzweck abhängt.

Hier würde ich zwei Schritte trennen. Im ersten Schritt muss geprüft werden, ob die Mail gemäß Absender, Inhalt, Format etc. eine gesuchte Mail ist. Ist die Mail für unseren Zweck "unbrauchbar", brechen wir die Verarbeitung ab. Im zweiten Schritt schneiden wir die Angaben, die wir nach Excel exportieren möchten aus der Mail aus.

Welche Parameter es gibt, sehen wir am Besten, wenn wir in der Zeile "MsgBox mIt.Subject" einen BreakPunkt setzen. Dazu setzen wir die Schreibmarke im Code Fenster in diese Zeile und drücken F9, oder klicken mit der Maus auf den grauen Balken links vom Code, oder klicken auf das Icon mit der Hand in der Iconleiste. Die Zeile wird braun hervorgehoben. Wenn die nächste Mail eintrifft, läuft der Code bis zum Breakpunkt. Wir zeigen das Fenster Überwachungsausdrücke (Watch Window) über View / Watch Window (Icon mit Textfeld und Brille) and und ziehen dann das Objekt mIt in das Fenster Überwachungsausdrücke. Links neben mIt erscheint ein Kreuz, das wir mit der Maus auffalten. Es erscheint eine Baumstruktur mit möglichen Parametern und deren aktuellen Werte.

Das weitere Vorgehen möchte ich am Beispiel folgender Mail darstellen. (Siehe Anlage Beispiel.jpg, Beispiel.msg)

Zuerst filtere ich wie vorhin erwähnt die Mails aus, die ich gar nicht haben möchte. Die meisten werden dabei über den Absender identifiziert:

If mIt.SenderName <> "service@chessmail.de" Then Exit Sub

Da dieser Absender aber auch andere Mails schickt, suchen wir eindeutigen Text in der Mail. Für diesen Absender ist der Text "Sie haben jetzt " nach zwei Zeilenschaltungen eindeutig. Da die Mail im HTML Format (mIt.BodyFormat=olFormatHTML) gesendet wird, können wir das Textmuster auf zwei verschiedene Arten suchen:

i = InStr(mIt.Body, vbCrLf & vbCrLf & "Sie haben jetzt ")

oder

i = InStr(mIt.HTMLBody, "<br/><br/>Sie haben jetzt ")

Beide Suchen geben die Positionsnummer des gesuchten Textstücks im Gesamttext zurück. Wenn nichts gefunden wird, ist das Ergebnis 0.

Nach diesen beiden Abfragen sollte die gefundene Mail eine richtige sein.

Jetzt können wir eine handvoll Variablen mit Daten füllen, die später nach Excel geschrieben werden sollen. Die nötigen weiteren Erklärungen habe ich in den Code hinein geschrieben.

Sub neue_mail(sID As String)
  Dim mIt As Outlook.MailItem 	' 1)
  ' Weitere Deklaration - gehört nach oben in den Deklarationsteil
  Dim i As Long   ' findet die Anfangs-Position im Text
  Dim j As Long   ' findet die End-Position im Text
  Dim d As Date   ' Datum der Mail
  Dim w As String ' Wer spielt weiß
  Dim s As String ' wer spielt schwarz
  Dim e As String ' Ergebnis
  Dim h As String ' Hyperlink
  Dim p As Long   ' Meine Punkte nach dem Spiel
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Deklaration
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' [...] 
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 1 - Die Mail ist identifiziert
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
  If mIt.SenderName <> "service@chessmail.de" Then Exit Sub
  i = InStr(mIt.Body, vbCrLf & vbCrLf & "Sie haben jetzt ")
  If i = 0 Then Exit Sub
 
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
  i = i + Len(vbCrLf & vbCrLf & "Sie haben jetzt ")
  ' i - Das ist jetzt die Position rechts von "Sie haben jetzt "
 
  j = InStr(i, mIt.Body, " Punkte")
  ' Der Text zwischen den Positionen i und j enthält jetzt 
  ' die Punktzahl
  ' MsgBox ">" & Mid(mIt.Body, i, j - i) & "<"
  ' nun wird dieser Text in eine Zahl vom Typ Long in 
  ' Variable p gespeichert
 
  p = CLng(Mid(mIt.Body, i, j - i))
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 2 - Die Mail hat den gesuchten Inhalt
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
  d = mIt.CreationTime
  i = InStr(mIt.Body, "Spielbrett ") + 1 ' hinter Spielbrett
  i = InStr(i, mIt.Body, Chr(34)) + 1    ' steht die Paarung in
  j = InStr(i, mIt.Body, Chr(34))        ' Gänsefüßchen chr(34)="
  Stmp = Mid(mIt.Body, i, j - i)
 
  ' "Split" teilt den String am zweiten Argument, hier "-"
  w = Split(Stmp, "-")(0) 
 
  ' In unserem Fall ergibt Split zwei Teile
  s = Split(Stmp, "-")(1) 
 
  i = InStr(mIt.Body, "HYPERLINK ") + Len("HYPERLINK ")
 
  i = InStr(i, mIt.Body, Chr(34)) + 1    ' steht die Paarung in
  j = InStr(i, mIt.Body, "Spielbrett")
  j = InStr(i, mIt.Body, Chr(34))        ' Gänsefüßchen chr(34)="
  h = Mid(mIt.Body, i, j - i)
 
  If InStr(mIt.Body, "Herzlichen Glückwunsch, Sie haben gewonnen.") Then 
    e = "gewonnen"
  ElseIf InStr(mIt.Body, "hat Sie schachmatt gesetzt") Then 
    e = "verloren"
  Else
    e = "unentschieden"
  End If
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 3 - alle Werte, die nach Excel geschrieben 
  ' werden müssen liegen jetzt in einzelnen Variablen vor.
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' ...

Bis "Ende Block 3" haben wir nichts verändert, sondern nur Daten gesammelt, überprüft und in Variablen gespeichert. Jetzt können wir die erste Veränderung durchführen. Zuerst markieren wir die Mail als gelesen und dann verschieben wir sie in den Outlook Ordner "Erledigt" (Wenn der Ordner nicht existiert, wird er angelegt).

  ' ...
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 3 - alle Werte, die nach Excel geschrieben 
  ' werden müssen liegen jetzt in einzelnen Variablen vor.
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  mIt.UnRead = False
  Stmp = ""
  For i = 1 To mIt.Parent.Folders.Count()
    If mIt.Parent.Folders(i).Name = "Erledigt" Then
      Stmp = "OK"
      Exit For
    End If
  Next i
  If Len(Stmp) = 0 Then mIt.Parent.Folders.Add "Erledigt"
  mIt.Move mIt.Parent.Folders("Erledigt")
  Set mIt = Nothing
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 4 - Mit der Mail sind wir fertig
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' ...

Abschließend müssen wir jetzt die gespeicherten Daten nach Excel schreiben. Zu diesem Zweck lege ich eine neue Excel Mappe unter "D:\temp\Wolle\Beispiel.xls" an. Das erste Blatt nenne ich "Ergebnisse". In die erste Zeile schreibe ich von links nach rechts folgende Überschriften: Datum, Weiß, Schwarz, Ergebnis, Punkte.

Außerdem benötigen wir ein Excel-Objekt, das uns ermöglicht aus Outlook in Excel zu arbeiten. Es gibt zwei Möglichkeiten, solche Excel-Objekte anzulegen und zu benutzen. Entweder man legt eine Variable ganz allgemein als Typ Object an, oder man bindet Excel in das Outlook-Objekt ein und legt das Objekt vom Typ Excel.Application an.

Ich entscheide mich während der Entwicklung für den zweiten Weg, da die automatische Ergänzung der Methoden die Programmierung erheblich einfacher macht. Der Nachteil ist jedoch, dass der Verweis bei jeder neuen Excel Version wieder angepasst werden muss. Das trifft vor allem auch bei der Programmweitergabe an andere Rechner mit abweichenden Excel-Versionen zu.

Anlegen des Verweises:
Im Visual Basic Fenster öffnen wir über das "Menü Tools / References..." einen Dialog mit den verfügbaren Verweisen. Dort wählen wir "Microsoft Excel 11.0 Object Library" (C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE) aus. Bei älteren Office Versionen steht dort statt 11 eine kleinere Zahl.

Das Excel Objekt kann wiederholt benutzt werden. Daher schreiben wir den entsprechenden Code in das Modul GL. Zuerst suchen wir mit GetObject, ob Excel bereits geöffnet ist. Wenn Excel nicht geöffnet ist, wird ein solches Objekt erstellt.

' ... 
 
' bei allgemeiner Deklaration Global XL As Object
Global XL As Excel.Application
 
' bei allgemeiner Deklaration Global XW As Object
Global XW As Excel.Workbook
 
' bei allgemeiner Deklaration Global XS As Object
Global XS As Excel.Worksheet
 
Sub set_XL()
  On Error Resume Next
  Set XL = GetObject(, "Excel.Application")
  If XL Is Nothing Then 
    Set XL = CreateObject("Excel.Application")
  End If
  On Error GoTo 0
End Sub

Jetzt können wir im Code MN.neue_mail() hinter Block 4 mit Excel beginnen. Dazu prüfen wir, ob es bereits ein Excel Objekt gibt, ob das entsprechende Workbook offen ist und legen diese gegebenenfalls an.

  ' ...
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 4 - Mit der Mail sind wir fertig
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If XL Is Nothing Then GL.set_XL
  XL.Visible = True
  For Each XW In XL.Workbooks
    If XW.FullName = "D:\temp\Wolle\Beispiel.xls" Then
      Exit For
    End If
  Next XW
  If XW Is Nothing Then 
    Set XW = XL.Workbooks.Open("D:\temp\Wolle\Beispiel.xls")
  End If
  XW.Activate
  Set XS = XW.Worksheets("Ergebnisse")
  XS.Activate
  XS.Select
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 5 - Excel ist bereit
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' ...

Als nächstes finden wir die nächste freie Zeile und schreiben in diese unter die passende Überschrift die Werte aus den Variablen, die wir in Block 1 gefüllt haben.

  ' ...
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 5 - Excel ist bereit
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  i = XL.WorksheetFunction.CountA(XS.Columns(1)) + 1 
  XS.Cells(i, 1) = d ' Datum
  XS.Cells(i, 2) = w ' Weiss
  XS.Cells(i, 3) = s ' Schwarz
  XS.Cells(i, 4).Hyperlinks.Add e, h
  XS.Cells(i, 5) = p
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Ende Block 6 - Excel ist gefüllt
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' ...

Abschließend müssen wir nur noch Excel wieder schließen und das NameSpace-Object löschen. Ich packe das jetzt in eine separate Prozedur im Modul GL. Der Grund dafür wird später gegeben.

Sub close_XL()
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Excel Object
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  If Not XS Is Nothing Then
    Set XS = Nothing
    If Not XW Is Nothing And XW.FullName = "D:\temp\Wolle\Beispiel.xls" Then
      XW.Close True 	' speichern + schließen der Datei Beispiel.xls
    End If
    For Each XW In XL.Workbooks 	' prüfen, ob es versteckte Workbooks gibt
      If XL.Windows(XW.Name).Visible Then Exit For
    Next XW
    If XW Is Nothing Then 	' Es gibt keine sichtbaren Workbooks
      For Each XW In XL.Workbooks
        XW.Close True 	' speichern + schließen der versteckten Workbooks
      Next XW
      XL.Quit 	' Beenden von Excel
      Set XL = Nothing
    End If
  End If
End Sub

So läuft die Speicherung von Daten aus Mails nach Excel. Jetzt gibt es noch ein Problem. Wir erhalten auch solche Mails, wenn wir offline sind. Daher müssen wir beim Hochfahren von Outlook kurz durch die ungelesenen Mails gehen und diese überprüfen. Dafür nutzen wir ein anderes Ereignis im Modul DieseOutlookSitzung. Aus der DropDown-Liste wählen wir Application und Startup.

' ...
Private Sub Application_Startup()
  Dim Oi As Object
  Dim Of As Object
  Dim c As Long 	' Zähler für ungelesene Mails
 
  ' Für jedes Postfach
  For Each Of In Outlook.Session.Folders 
    ' Fehler Pop-Up wird unterdrückt
    On Error Resume Next 
    c = Of.Folders("Inbox").UnReadItemCount
    ' -> Führt zum Fehler, wenn der Mailserver nicht erreicht wird
    If Err.Number = 0 Then 	' es liegt kein Fehler vor
      On Error GoTo 0 	' Fehler Pop-Up wird re-aktiviert
      ' Für jede Mail im Ordner Inbox
      For Each Oi In Of.Folders("Inbox").Items 
        If Oi.UnRead Then
          If TypeName(Oi) = "MailItem" Then
            MN.neue_mail Oi.EntryID
          End If
          c = c - 1
          If c = 0 Then Exit For
        End If
      Next Oi
    End If
  Next Of
  ' Fehler Pop-Up wird re-aktiviert
  On Error GoTo 0 
 
  ' Excel speichern und schließen
  GL.close_XL 
End Sub

Hier sieht man dann auch, dass es Sinn macht, die eventuell geöffnete Excel-Datei einmal am Ende zu schließen. Deshalb wird GL.close_all auch nur einmal abschließend ausgeführt.

Dieser Aufruf muss jetzt aber auch in das Modul:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
  Call MN.neue_mail(EntryIDCollection)
  GL.close_XL 	' Excel speichern und schließen
End Sub

Und es schadet nichts, wenn man diesen Aufruf auch durchführt, wenn man Outlook beendet.

Private Sub Application_Quit()
  GL.close_XL 	' Excel speichern und schließen
  If Not NS Is Nothing Then Set NS = Nothing
End Sub

Alle Codes und Beispiel-Dateien sind als Anlage beigefügt.