ich habe leider nicht so viel Ahnung von VBA und möchte gerne aus einem ausgewähltem Outlook Ordner die Kopfzeilen der vorhandenen EMails (Absender, Betreff und Datum) in eine Excel Tabelle exportieren.
Kann mir jemand weiterhelfen?
Vielen Dank!
Option Explicit
'Benötigt den Verweis auf Microsoft Outlook Object Library
Sub MailsImportieren()
Dim objOutlook As Outlook.Application
Dim objnSpace As Namespace
Dim objFolder As MAPIFolder
Dim objMsg As MailItem
Dim LRow As Long
Dim myAr() As Variant
Set objOutlook = New Outlook.Application
Set objnSpace = objOutlook.GetNamespace("MAPI")
Set objFolder = objnSpace.PickFolder ''' Dialog
With Sheets("Outlook") 'Tabellennamen anpassen !!!!!!!
'Zellen leer machen für neue Daten
.Range("A2:C" & .Rows.Count).Clear
'Überschrift
.Cells(1, 1) = "Absender"
.Cells(1, 2) = "Datum"
.Cells(1, 3) = "Betreff"
.Range("A1:C1").Font.Bold = True
'Array Dimensionieren
Redim myAr(1 To objFolder.Items.Count, 1 To 3)
'Mails aus Ordner lesen
For Each objMsg In objFolder.Items
LRow = LRow + 1
myAr(LRow, 1) = objMsg.SenderEmailAddress 'Mail- Adresse
myAr(LRow, 2) = objMsg.ReceivedTime 'Datum
myAr(LRow, 3) = objMsg.Subject 'Betreff
Next objMsg
'Daten in Zellen schreiben
.Range("A2").Resize(LRow, 3) = myAr
'Breite der Spalten anpassen
.Columns("A:C").EntireColumn.AutoFit
End With
End Sub
Gruß Tino