Outlook 2016 Emails mit Formatierung nach Excel importieren

[Karin-Lana]

Hallo Zusammen,

VBA Abfrage in Excel - auslesen von Emails aus Outlook 2016 mit Formatierung.

Ich möchte gerne Emails aus einem Unterordner (nennen wir ihn "Profile") des Posteingangs auslesen und diese in Excel importieren. Jedes Email soll in einer Zeile dargestellt sein. Spaltenüberschriften sollen sein: von / an / Betreff / Datum Uhrzeit / Emailtext

In den Emails sind bestimmte Worte "gelb" markiert. Diese Markierung (Formatierung des Emails ?) brauche ich in Excel um danach zu suchen und damit weiterzuarbeiten.

Ich habe hier im Forum schon ähnliche Macros gesehen, diese auch versucht umzuschreiben - keine Chance!
Dazu brauche ich eure Hilfe!

Ich freue mich über jeden Hinweis.

[schauan]

Hallo Karin,

wenn Du es schon ohne Formatierung hinbekommen hast, dann poste doch mal den Code.
Ich nehme an, wenn es überhaupt funktionieren soll, müsstest Du den E-Mail-Text als html auslesen und schauen, wo die Farbtags sind.

[Karin-Lana]

Hallo,

ich habe folgenden Code gefunden, der aber bei mir nicht läuft und auch nicht auf den Unterordner referenziert.

Code:

Sub OutlookPosteingang()
'Variablendeklaration
Dim OLF As Outlook.MAPIFolder
Dim AnzEintraege As Integer, i As Integer, Email As Integer
' Hier wird Tabelle hinzugefügt
Sheets.Add
'Globale Fehlerbehandlung  -> Excel soll automatisch weitermachen, egal welcher Fehler
On Error Resume Next
' Überschriften im neuen Blatt  -> die erste Zeile von A1 - E1
[A1].Value = "Betreff"
[B1].Value = "Datum Uhrzeit"
[C1].Value = "empfangen von"
[D1].Value = "gelesen"
[E1].Value = "Nachricht"
'Erste Zeile Fett formatiert
Rows(1).Font.Bold = True
'Setzen der Variable als Outlook Application; Zugriff auf Outlook
Set OLF = GetObject("", "Outlook.Application") _
    .GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
'Setzen Variable -> es sollen alle Nachrichten im Ordner 'Posteingang (olFolderInbox) gezählt werden
AnzEintraege = OLF.Items.Count
'Setzen der Variablen auf '0'
i = 0: Email = 0
'Beginn Schleifendurchlauf (Schleife 1)  -> die Variable 'i' läuft solange, wie Anzahl der EMails vorhanden sind
While i < AnzEintraege
    i = i + 1
    'Anzeigen einer Nachricht in der Statuszeile
    Application.StatusBar = "Lese Posteingang " & _
        Format(i / AnzEintraege, "0%")
        'Was soll mit den Nachrichten geschehen?  (Schleife 2)
    With OLF.Items(i)
        Email = Email + 1
        'Zelle 1 mit dem Wert Betreff in der EMail
        Cells(Email + 1, 1).Value = .Subject
        'Zelle 2 mit dem Wert 'Empfangen am' in der EMail
        Cells(Email + 1, 2).Value = .ReceivedTime
        'Zelle 3 Absender
        Cells(Email + 1, 3).Value = .SenderName
        'Zelle 4 der gelesenen Nachrichten
        Cells(Email + 1, 4).Value = Not .UnRead
        'Zelle 5 mit der eigentlichen Nachricht
        Cells(Email + 1, 5).Value = .Body
         'Ende der Schleife 2
    End With
'Ende der Schleife 1
Wend
'Die Variable muss wieder auf Null gesetzt werden = nothing halt
Set OLF = Nothing
'Die Spalten sollen automatisch in der Breite angeglichen werden
Columns("A:E").AutoFit
'Die Zelle 'A2' soll selektiert werden
[A2].Select
'Die Exceldatei wird gespeichert
ActiveWorkbook.Saved = True
'Die Statuszeile wird wieder ausgeschaltet
Application.StatusBar = False
End Sub

Vielleicht kann das jemand anpassen.

Danke
Karin

[Karin-Lana]

So, dieser Code läuft durch. Jetzt fehlt mir nur noch, wie ich HTML Format nach Excel bekomme.
Vielleicht hat hier jemand eine Info für mich.

Code:

Sub OutlookPosteingang()
 
'Variablendeklaration
Dim olApp As Outlook.Application
Dim olVerz As Outlook.MAPIFolder
Set olApp = CreateObject("Outlook.Application")
Set olVerz = olApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Folders("Test")
 
Dim AnzEintraege As Integer, i As Integer, Email As Integer
'  Hier wird eine Tabelle hinzugefügt
 Sheets.Add

'Globale Fehlerbehandlung  -> Excel soll automatisch weitermachen, egal welcher Fehler
'On Error Resume Next'
 
' Überschriften im neuen Blatt  -> die erste Zeile von A1 - F1
[A1].Value = "Betreff"
[B1].Value = "Datum Uhrzeit"
[C1].Value = "empfangen von"
[D1].Value = "gelesen"
[E1].Value = "Nachricht"
[F1].Value = "Dateianhänge"
 
'Erste Zeile soll Fett formatiert werden
Rows(1).Font.Bold = True
 
'Setzen der Variable als Outlook Application; Zugriff auf Outlook
Set OLF = GetObject("", "Outlook.Application") _
.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Folders("Test")
 
'Setzen der Variable -> es sollen alle Nachrichten im Ordner 'Test (Folders) gezählt werden
AnzEintraege = OLF.Items.Count
'Setzen der Variablen auf '0'
i = 0: Email = 0
'Beginn Schleifendurchlauf (Schleife 1)  -> die Variable 'i' läuft solange, wie Anzahl der EMails vorhanden sind
While i < AnzEintraege
    i = i + 1
    'Anzeigen einer Nachricht in der Statuszeile
    Application.StatusBar = "Lese Test" & _
    Format(i / AnzEintraege, "0%")
        'Was soll mit den Nachrichten geschehen?  (Schleife 2)
    With OLF.Items(i)
        Email = Email + 1
        'Zelle 1 mit dem Wert Betreff in der EMail
        Cells(Email + 1, 1).Value = .Subject
        'Zelle 2 mit dem Wert 'Empfangen am' in der EMail
        Cells(Email + 1, 2).Value = .ReceivedTime
        'Zelle 3 Absender
        Cells(Email + 1, 3).Value = .SenderName
        'Zelle 4 der gelesenen Nachrichten
        Cells(Email + 1, 4).Value = Not .UnRead
        'Zelle 5 mit der eigentlichen Nachricht
        Cells(Email + 1, 5).Value = .Body
        'Zelle 6 -> Anzahl der Anhänge in der EMail
        Cells(Email + 1, 6).Value = .Attachments.Count
 'Löschen der Leerzeilen"
Dim lgCount As Long
Dim lgLetzte As Long
lgLetzte = Range("E65536").End(xlUp).Row
For lgCount = lgLetzte To 1 Step -1
    If IsEmpty(Cells(lgCount, 1)) Then
        Cells(lgCount, 1).Delete shift:=xlUp
End If
Next
 'Ende der Schleife 2
    End With
'Ende der Schleife 1
Wend
'Die Variable muss wieder auf Null gesetzt werden = nothing halt
Set OLF = Nothing
'Die Spalten sollen automatisch in der Breite angeglichen werden
Columns("A:F").AutoFit
'Die Zelle 'A2' soll selektiert werden
[A2].Select
'Die Exceldatei wird gespeichert
ActiveWorkbook.Saved = True
'Die Statuszeile wird wieder ausgeschaltet
Application.StatusBar = False
End Sub

 
 

[schauan]

Hallo Karin,

erst mal ein Anfang mit dem html-body. Den bekommst Du z.B. so:

Code:

strhb = Right(.HTMLBody, Len(.HTMLBody) - InStr(1, .HTMLBody, "</head>") - 6)

Als nächstes müsstest Du den Body nach den Farben durchsuchen, die könnten z.B. so codiert sein:

PHP-Code:

<span style='color:red'>Dokumentenordner</span> 


Du könntest in dem String also z.B. nach Color suchen, zwischen Doppelpunkt und Hochkomma steht dann die Farbe, und der anschließende Text bis zum Spanende bekommt selbige dann.

[Karin-Lana]

Hallo schauan,

es läuft jetzt durch, aber das Ergebnis ist wie folgt und hilft leider nicht.


<meta name="Generator" content="Microsoft Word 15 (filtered medium)">
<style>

[schauan]

Hallo Karin,

die Codezeile muss erst mal irgendwo zwischen With OLF.Items(i) und End With stehen.
Den erzeugten String könntest Du Dir z.B. erst mal mit Debug.Print strhb im Direktfenster ausgeben oder packst ihn in eine Zelle.

Dann solltest Du sie auch wie von mir gepostet schreiben,

also nicht
… InStr(1, .HTMLBody, "") ...
sondern
… InStr(1, .HTMLBody, "") …

Ein Problemchen könnte es geben, wenn es sich um eine Textmail handelt und keine html-mail. Mit dem InStr könntest Du das vorab prüfen

If InStr(1, .HTMLBody, "") > 0 then
… hier den string bilden
End if

[Karin-Lana]

Hallo Schauan,

sorry dass ich nochmal Nachfrage, hast du versehentlich den gleichen Befehl kopiert?

Zitat aus deiner Nachricht:

also nicht
… InStr(1, .HTMLBody, "") ...
sondern
… InStr(1, .HTMLBody, "") …

Da gibt es jetzt kein Unterschied in den beiden genannten Befehlen.....

Danke dir.

Viele Grüße
Karin

[schauan]

Hallo Karin,

danke für den Hinweis, aber das hat eine andere Ursache Die Forumsseite versucht, den Code zu interpretieren …
Hier mal in Code-Tags, damit das nicht passiert:

PHP-Code:

… InStr(1, .HTMLBody, "</head>") … 


Das sieht dann aus wie in #5

[Karin-Lana]

ich komme nicht weiter, bin gerade genervt. Mache jetzt mal Feierabend. 

Komme Morgen wieder rein. Vielleicht bin ich dann ein Stück weiter.

Liebe Grüße
Karin