AW: emails in excel einlesen
09.05.2005 14:19:23
marcl
Sorry,
hier ist das Makro zum Posteingang auslesen. Allerdings auf Outlook basiert. Ob es Unterschiede macht, habe ich leider keine Ahnung.
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