jerry0110
Erfahrenes Mitglied
Das ist jetzt mein vollständiger Code. Jetzt habe ich natürlich im Netz geguckt, wie ich den Betreff und das Datum der Mail auslesen kann. Das klappt auch. ABER. Er nimmt jetzt nur die Mails in meinem Hauptpostfach und nicht mehr aus dem Test Ordner.
Das ist der Teil, wo ich auf die Teile der Email zugreife. In dem Code unten wird ja auch auf die Email zugegriffen. Wie kann ich jetzt das so nutzen, dass ich nicht doppelt auf die Mail zugreife, sodass er auch im Ordner Test bleibt und nicht im Hauptordner.
Visual Basic:
For Each olMail In olFolder.Items
If olMail.Subject Like "*Auswertung Resa ausgehende Emails" ThenDas ist der Teil, wo ich auf die Teile der Email zugreife. In dem Code unten wird ja auch auf die Email zugegriffen. Wie kann ich jetzt das so nutzen, dass ich nicht doppelt auf die Mail zugreife, sodass er auch im Ordner Test bleibt und nicht im Hauptordner.
Visual Basic:
Dim otl As Outlook.Application
Dim ns As Outlook.Namespace
Dim fld As Outlook.MAPIFolder
Dim mail As Outlook.MailItem
Dim f As Long
Dim letzte As Long
Dim letzte2 As Long
Dim ziel As Worksheet
Dim ziel2 As Worksheet
Dim olFolder As Object
Dim olMail As Object
Dim olApp As Object
Dim match As Object
Dim Items As Object
Set olApp = CreateObject("Outlook.Application")
Set otl = New Outlook.Application
Set ns = otl.GetNamespace("MAPI")
Set fld = ns.Folders(C_MAPI).Folders(C_FOLDER)
Set mail = fld.Items.GetFirst
Set ziel = ThisWorkbook.Worksheets("Gesamt Eingang")
Set ziel2 = ThisWorkbook.Worksheets("Gesamt Ausgang")
Set olFolder = olApp.ActiveExplorer.CurrentFolder
'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
For Each olMail In olFolder.Items
If olMail.Subject Like "*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 Like "*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" & letzte2).Value = Format(olMail.ReceivedTime, "DD.MM.YYYY") - 1
ziel2.Range("B" & letzte2).Value = Items(0)
ziel2.Range("C" & letzte2).Value = Items(1)
ziel2.Range("D" & letzte2).Value = Items(2)
ziel2.Range("E" & letzte2).Value = Items(3)
ziel2.Range("F" & letzte2).Value = Items(4)
ziel2.Range("G" & letzte2).Value = Items(5)
letzte2 = letzte2 + 1
Next match
End If
Next
