| Rubrik: Verschiedenes | VB-Versionen: VBA | 01.12.06 |
 Mail to Excel - autom. Auswertung von Mails in MS-OutlookAnhand 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:   | Views: 34.402 |
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:
- Deklaration für ein MailItem
- Sicherstellen, dass das NameSpace-Objekt existiert
- 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.
