AW: Formulareinträge aus Outlook in Excel
25.04.2011 14:12:21
Tino
Hallo,
Du könntest die Mails einzeln durchsuchen und entsprechend raus filtern.
Hier ein Beispiel, es werden Mails in den Zeitraum vonDatum bis bisDatum gefiltert und ausgelesen.
Eine Erweiterung an Deine Vorhaben müsste entsprechend noch erweitert werden.
'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, objItems As Object
Dim LRow As Long
Dim myAr() As Variant
Dim vonDatum As Date, bisDatum As Date
vonDatum = Date - 10
bisDatum = Date
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
objFolder.Items.Sort "[ReceivedTime]"
Set objItems = objFolder.Items.Restrict("[ReceivedTime] >= '" & _
Format(vonDatum, "dd.mm.yyyy hh:mm") & "' AND [ReceivedTime] <= '" & _
Format(bisDatum, "dd.mm.yyyy hh:mm") & "'")
Redim myAr(1 To objItems.Count, 1 To 3)
'Mails aus Ordner lesen
For Each objMsg In objItems
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