Mail export Outlook
25.01.2017 20:11:02
Tobias
ich habe diese Frage schon einmal gestellt und auch eine Antwort erhalten, leider funktioniert der vba code noch nicht ganz und ich finde gerade keinen weg den alten Beitrag wieder nach oben zu holen, bzw darauf erneut zu antworten. deswegen leider dieser weg.
Hier noch einmal mein Problem:
Und zwar bekomme ich regelmäßig eine Mail mit Daten, diese Daten möchte ich gerne via Makro nach Excel exportieren.
Das klappt bisher soweit auch ganz gut, das einzige Problem ist, das der gesamte Mail Inhalt in Zelle A1 eingefügt wird.
Mein Wunsch wäre es das die Daten in die Zellen A1 - A32 eingefügt werden.
Die Mail gliedert sich so
"Informationen zu ...."
01.01.2017 Aktueller Dienst: XX
02.01.2017 Aktueller Dienst: YY
Jedes Datum soll also in eine Zelle.
Hier der FAST funktionierende Code:
Sub OutlookPosteingang()
'Variablendeklaration
Dim OLF As Outlook.MAPIFolder
Dim AnzEintraege As Integer, i As Integer, Email As Integer
Dim varBody, intBody As Integer
' Hier wird eine Tabelle hinzugefügt
ActiveSheet.Name = i
'Globale Fehlerbehandlung -> Excel soll automatisch weitermachen, egal welcher Fehler
On Error Resume Next
' Überschriften im neuen Blatt -> die erste Zeile von A1 - B1
[A1].Value = ""
'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)
'Setzen der 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 0 Then
Cells(Email, 2).Value = Left(varBody, InStr(varBody(intBody), ":"))
Cells(Email, 3).Value = Trim(Mid(varBody, InStr(varBody(intBody), ":") + 1))
Else
Cells(Email, 2).Value = varBody(intBody)
End If
Else
Cells(Email, 1).Value = varBody(intBody)
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
Durch den Code werden die Daten sehr schön in die gewünschten Zellen geschrieben. Leider jedoch verschwindet jedoch auch der benötigte Text nach dem Datum.
Was muss ich wo einfügen?
Vielen Dank für eure Hilfe.