AW: Mails aus Outlook nach Adressen filtern
Marcl
Hallo Herbert,
Verweise für Outlook im MakroEditor setzen: Extras / Verweise / Haken bei Microsoft Office 10.0 Objekt Library (oder was bei Dir halt steht)
hier mal was richtiges:
Sub OutlookPosteingang()
'Variablendeklaration
Dim OLF As Outlook.MAPIFolder
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)
'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 < 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
'Zelle 6 -> Anzahl der Anhänge in der EMail
Cells(Email + 1, 6).Value = .Attachments.Count
'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
Gruß
Marcl