Excel VBA - Emailbody aus Outlook auslesen


jerry0110

Erfahrenes Mitglied
Hallo zusammen,

ich möchte gerne von täglichen Emails den Body auslesen.
In dem Body Text ist eine Tabelle die mir Daten liefert.

Diese sieht wie folgt aus:

SenderMassageSPAM MailsOther MsgAdult Spam MailsVirus Mails
test@xyz.de20010253040
info@xyz.de50010205214

Und dann geht das immer so weiter.

Ich möchte diese Tabelle auslesen und dann in eine Tabelle einfügen mit Datum, von wann die Email ist.
So dass ich diese dann auswerten kann.

Kann mir jemand da unter die Arme greifen? Habe leider nichts passendes im Internet gefunden.
 

Yaslaw

n/a
Moderator
Jetzt ist die grosse Frage, in was für einem Format die Tabelle vorliegt.
Kannst du mal ein Beispielmail speichern und zippen und dann hier hochladen?
 

Yaslaw

n/a
Moderator
Die Tabelle kommt im Body-Attribut als Text heraus. Die Zeilen sind mit jeweils 2 Wagenrücklauf+Zeilenumbruch getrennt.

Das kann man ausnutzen und ein RegEx setzen.
Hier mein Test: Regex101 - online regex editor and debugger

Und als Code:
Visual Basic:
Public Sub mailTest()
    Const C_MAPI = "myMailadresse@firma.com"
    Const C_FOLDER = "TEST"
    
    'Das Test-Mail auslesen
    Dim otl As Outlook.Application:     Set otl = New Outlook.Application
    Dim ns As Outlook.Namespace:        Set ns = otl.GetNamespace("MAPI")
    Dim fld As Outlook.MAPIFolder:      Set fld = ns.Folders(C_MAPI).Folders(C_FOLDER)
    Dim mail As Outlook.MailItem:       Set mail = fld.items.GetFirst
    
    'RegExp definieren
    Dim rx As Object:                   Set rx = CreateObject("VBScript.RegExp")
    rx.pattern = "\b([\w.%+-]+@[\w.-]+\.[A-Z]{2,})\b(?: <mailto:[\w.%+-]+@[\w.-]+\.[A-Z]{2,}>)?\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)"
    rx.ignoreCase = True
    rx.Global = True
    
    'Prüfen ob der Body eine Tabelle enthält
    If Not rx.test(mail.body) Then
        MsgBox "Mailbody passt nicht"
        Exit Sub
    End If
    
    'Mit dem RegEx die einzelnen Zeilen auslsen
    Dim match As Object: For Each match In rx.execute(mail.body)
        Dim items As Object: Set items = match.SubMatches
        '//TODO: Anstelle des debug.print diese in eine neie Zeile eines Excelsheets schreiben
        Debug.Print items(0), items(1), items(2), items(3), items(4), items(5)
    Next match
End Sub
Ausgabe:
Code:
xyz@info.de   1557          0             1557          0             0
xyz@info.de   1344          0             1344          0             0
xyz@info.de   135           0             135           0             0
xyz@info.de   25            0             25            0             0
xyz@info.de   8             0             8             0             0
xyz@info.de   4             0             4             0             0
 

jerry0110

Erfahrenes Mitglied
Ich habe den Code jetzt in eine Excel eingebaut und dann oben meine Emailadresse und das Postfach angegeben wo die Mail drin ist. Wenn ich es starte dann kommt direkt in Zeile 6 die Fehlermeldung "Fehler beim Kompilieren: Benutzerdefinierter Typ nicht definiert
 

Yaslaw

n/a
Moderator
Ich dachte, die Mailgeschichte per se hast du drin. Egal. Setze eine Referenz auf
Microsoft Outlook 16.0 Object Library
Wobei die Zahl 16 bei dir auch eine andere sein kann.
 

jerry0110

Erfahrenes Mitglied
Die Tabelle kommt im Body-Attribut als Text heraus. Die Zeilen sind mit jeweils 2 Wagenrücklauf+Zeilenumbruch getrennt.

Das kann man ausnutzen und ein RegEx setzen.
Hier mein Test: Regex101 - online regex editor and debugger

Und als Code:
Visual Basic:
Public Sub mailTest()
    Const C_MAPI = "myMailadresse@firma.com"
    Const C_FOLDER = "TEST"
  
    'Das Test-Mail auslesen
    Dim otl As Outlook.Application:     Set otl = New Outlook.Application
    Dim ns As Outlook.Namespace:        Set ns = otl.GetNamespace("MAPI")
    Dim fld As Outlook.MAPIFolder:      Set fld = ns.Folders(C_MAPI).Folders(C_FOLDER)
    Dim mail As Outlook.MailItem:       Set mail = fld.items.GetFirst
Ich habe jetzt bei Const C_MAPI meine Emailadresse von meinem Postfach reingeschrieben und bei dem Folder den neu angelegten Ordner Test. Leider sagt er immer das er den Ordner nicht findet.

Ich habe dann mal aus ns.Folders(C_MAPI).Folders(C_FOLDER)

ns.GetDefaultFolder(olFolderInbox).Folders("Test") gemacht.
Dann kommt keine Fehlermeldung aber es kommt kein Debug Print. Es wird nichts ausgegeben.
Im Ordner Test ist die Email drin, die ich hier reingepackt habe.
 

Yaslaw

n/a
Moderator
Ich kenne deine Ordnerstruktuir im Outlook nicht. Bei mir sieht sie so aus.
Unter dem Zensurbalken ist der Ordner, den ich im Code C_MAPI genannt habe
Darunter habe ich den TEST. Du musst dih halt bei dir entsprechen durch deine Struktur angeln.
2020-02-05_152244.jpg
 

jerry0110

Erfahrenes Mitglied
Das habe ich jetzt genauso bei mir.

Habe jetzt nach der If Schleife eine Msgbox eingefügt. (MsgBox rx.test(mail.Body))
Die gibt mir "WAHR" aus.

Also müsste er dann ja den Debug.Print ausführen. Macht er aber nicht.

Aber wenn ich eine Msgbox (msgbox items(0)) am Ende ausführe bekomme ich die Daten.
Dann muss ich ja nur noch statt msgbox die Werte in die Tabelle einführen.
 

jerry0110

Erfahrenes Mitglied
Ich habe hierzu noch mal eine Frage.
Wenn ich das Array items(0) über die msgbox aufrufe funktioniert das ohne Probleme.

Wenn ich jetzt den u. s. Code nutze, dann kommt immer der Fehler, Objekt unterstützt diese Eigenschaft oder Methode nicht. Warum? Auch ohne .Value klappt es bei items nicht

Visual Basic:
        If items(0) = "xyz@test.de" Then
            ThisWorkbook.Worksheet("xyz@test.de").Range("B2").Value = items(1).Value
            ThisWorkbook.Worksheet("xyz@test.de").Range("C2").Value = items(2).Value
            ThisWorkbook.Worksheet("xyz@test.de").Range("D2").Value = items(3).Value
            ThisWorkbook.Worksheet("xyz@test.de").Range("E2").Value = items(4).Value
            ThisWorkbook.Worksheet("xyz@test.de").Range("F2").Value = items(5).Value
        End If
 

Yaslaw

n/a
Moderator
Warum itesm(#).Value?
Und wo GENAU kommt WELCHER Fehle wenn du ohne .Value arbeitest?
Schon bei items(1) oder erst bei items(5)?

ThisWorkbook.Worksheet("xyz@test.de").Range("B2").Value = items(1)


Setz mal ein Breakpoint und schau die items. mal genauer an.
 

jerry0110

Erfahrenes Mitglied
Der Fehler kommt direkt beim "
ThisWorkbook.Worksheet("xyz@test.de").Range("B2").Value = items(1).Value
"
ich habe alle items mit msgbox(en) vorher versehen.
Items(1) = xyz@test.de
items(2) = eine Zahl
.
.
.

In der msgbox wird alles korrekt angezeigt.
 

jerry0110

Erfahrenes Mitglied
Wenn ich einen Breakpoint lege und mit der Maus über die einzelnen items gehe, dann sehe ich alle werte die es enthält.
 

Yaslaw

n/a
Moderator
Finde den Unterschied, das Erste ist mein Code, der Zweite deiner.

ThisWorkbook.Worksheet("xyz@test.de").Range("B2").Value = items(1)
ThisWorkbook.Worksheet("xyz@test.de").Range("B2").Value = items(1).Value

Zudem:
Warum itesm(#).Value?
 

Yaslaw

n/a
Moderator
Bei mir wird sogar markiert, was falsch ist. Es markiert Worksheet.

2020-02-06_121422.jpg

Ein Workbook hat kein Property names Worksheet. Jedoch hat es Worksheets

ThisWorkbook.Worksheets("xyz@test.de").Range("B2").Value = items(1)
 

jerry0110

Erfahrenes Mitglied
Einträge funktionieren jetzt und er schreibt es in die Spalte.

So jetzt kommt das nächste Problem.

Ich muss den Email Betreff und das Datum der Mail auslesen.
Anhand des Betreffs muss der untere Code dann in das richtige Sheet geschrieben werden.
Funktioniert aber leider nicht.

Ich hatte zum Testen nach der For Each olMail
Visual Basic:
msgbox olMail.subject
stehen und er hat dann auch den Betreff ausgegeben. In der Schleife selber macht er das leider nicht.

folgendes habe ich zum Guten gegeben:

Visual Basic:
    For Each olMail In olFolder.Items
        
        If olMail.Subject = "*Auswertung Resa ausgehende Emails*" Then
            
           'Mit dem RegEx die einzelnen Zeilen auslsen
          
           letzte = Sheets("Gesamt Eingang").UsedRange.SpecialCells(xlCellTypeLastCell).Row
                
           For Each match In rx.Execute(mail.Body)
           Set Items = match.SubMatches
           '//TODO: Anstelle des debug.print diese in eine neie Zeile eines Excelsheets schreiben
          
               ziel.Range("A" & letzte).Value = Format(olMail.ReceivedTime, "DD.MM.YYYY") - 1
               ziel.Range("B" & letzte).Value = Items(0)
               ziel.Range("C" & letzte).Value = Items(1)
               ziel.Range("D" & letzte).Value = Items(2)
               ziel.Range("E" & letzte).Value = Items(3)
               ziel.Range("F" & letzte).Value = Items(4)
               ziel.Range("G" & letzte).Value = Items(5)
              
               letzte = letzte + 1
        
           Next match
        
        ElseIf olMail.Subject = "*Auswertung Resa eingehende Emails*" Then
            
        'Mit dem RegEx die einzelnen Zeilen auslsen
        
           letzte2 = Sheets("Gesamt Ausgang").UsedRange.SpecialCells(xlCellTypeLastCell).Row
                
           For Each match In rx.Execute(mail.Body)
           Set Items = match.SubMatches
           '//TODO: Anstelle des debug.print diese in eine neie Zeile eines Excelsheets schreiben
          
               ziel2.Range("A" & letzte).Value = Format(olMail.ReceivedTime, "DD.MM.YYYY") - 1
               ziel2.Range("B" & letzte).Value = Items(0)
               ziel2.Range("C" & letzte).Value = Items(1)
               ziel2.Range("D" & letzte).Value = Items(2)
               ziel2.Range("E" & letzte).Value = Items(3)
               ziel2.Range("F" & letzte).Value = Items(4)
               ziel2.Range("G" & letzte).Value = Items(5)
              
               letzte2 = letzte2 + 1
        
           Next match
        
        End If
    
        
    Next
 

Yaslaw

n/a
Moderator
Das solltest du doch wissen. = bedeutet gleich und nicht enthält. Die * im Vergleichstring würden also nur dann richtig sein, wenn auch das Subjekt * enthält

Was du haben willst ist like
Code:
?"abc" = "abc*"
False
?"abcde" = "abc*"
False

?"abc" like "abc*"
True
?"abcde" like "abc*"
True