Outlook-Workshop - Email auslesen - Teil 1

Für die nächsten beiden Teile sollten Sie schon über etwas Erfahrung im Zusammenspiel zwischen Excel und Outlook-Mailkonten gesammelt haben.

In den Foren auch häufig erfragt ist die Möglichkeit zum Auslesen von Emails. Hier lernen wir wie man den Inhalt von Emails auslesen und in eine Exceldatei eintragen kann. Im Beispiel werden Absender, Absender-Emailadresse, das Sendedatum und die Namen der Anhänge ausgelesen.

Kommen wir zuerst zum Aufbau der Tabelle.




Kommen wir nun zur Prozedur. Sie müssen in dieser den Namen des Kontos und des Tabellenblattes anpassen.

Option Explicit

Public Sub ReadMailItems()
Dim olapp        As Object
Dim olName       As Object
Dim olHFolder    As Object
Dim olUFolder    As Object

Dim strAttCount  As String

Dim olItemsCount As Long
Dim lngAttCount  As Long
Dim letzteZeile  As Long


On Error Resume Next

Set olapp = CreateObject("Outlook.Application")
Set olName = olapp.GetNamespace("MAPI")
Set olHFolder = olName.Session.Folders("RMH Software") ' Kontoname 
Set olUFolder = olHFolder.Folders("Posteingang") 'Ordnername 


letzteZeile = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row

   For olItemsCount = 1 To olUFolder.Items.Count
       With olUFolder.Items.Item(olItemsCount)
       
                 For lngAttCount = 1 To .Attachments.Count
                       If strAttCount = "" Then
                          strAttCount = .Attachments.Item(lngAttCount).Filename
                       Else
                          strAttCount = strAttCount & vbCrLf & .Attachments.Item(lngAttCount).Filename
                       End If
                 Next lngAttCount
                   
                 Sheets("Master").Range("A" & olItemsCount + letzteZeile).Value = olHFolder.Name & "->" & olUFolder.Name
                 Sheets("Master").Range("B" & olItemsCount + letzteZeile).Value = .Sender
                 Sheets("Master").Range("C" & olItemsCount + letzteZeile).Value = .SenderEmailAddress
                 Sheets("Master").Range("D" & olItemsCount + letzteZeile).Value = .ReceivedTime
                 Sheets("Master").Range("E" & olItemsCount + letzteZeile).Value = .Subject
                 Sheets("Master").Range("F" & olItemsCount + letzteZeile).Value = strAttCount
                        
                 strAttCount = ""
       End With
   Next olItemsCount
   
On Error GoTo 0

End Sub