ich möchte Nachrichten, die in Outlook ankommen und von einem bestimmten Absender sind, automatisch in einer Excel-Tabelle speichern um sie dann weiterverarbeiten zu können? Wie gehe ich dabei am besten vor?
Danke für eure Hilfe!
Johannes
ich möchte Nachrichten, die in Outlook ankommen und von einem bestimmten Absender sind, automatisch in einer Excel-Tabelle speichern um sie dann weiterverarbeiten zu können? Wie gehe ich dabei am besten vor?
Danke für eure Hilfe!
Johannes
wenn Du unter automatisch verstehst, dass diese Aktion beim Eintreffen der Mail passieren soll, bist Du im falschen Forum - das muss dann in Outlook in dem Modul DieseOutlookSitzung hinterlegt werden.
Code eingefügt mit Syntaxhighlighter 1.15
' Excel mit CreateObject starten
Sub LaunchExcel01()
'!!!WICHTIG!!! Verweis auf Excel muss gesetzt sein !!!!
'
' Hier als normales Makro, dass von Outlook zur Überprüfung
' zuerst von Hand gestartet werden sollte
' Öffnet eine Instanz von Excel, öffnet die Mappe
' schreibt die Daten. speichert die Mappe und schließt Excel
'
' Bei Verlegung in DieseOutlookSitzung muss das Makro
' in Private Sub Application_NewMail() umbenannt werden
' Dim objPosteingang As MAPIFolder
Dim objNewMail As MailItem
Dim xlApp 'As Excel.Application ' Diese Anweisungen sollten beibehalten werden!
Dim xlSheet 'As Excel.Worksheet ' dto.
Set xlApp = CreateObject("Excel.Application")
If Err Then
MsgBox "Excel-Anwendung kann nicht erstellt werden", vbCritical
Exit Sub
End If
' Der Pfad und der Name der Arbeitsmappe sind anzupassen
xlApp.Workbooks.Open "C:\Temp\OutlookEingang.xls"
' Hier wird auf das erste Blatt der Arbeitsmappe zugegriffen
Set xlSheet = xlApp.Sheets(1)
' Excel wird zu Testzwecken in den Vordergrund gebracht
xlApp.Visible = True
intLastRow = Cells(Rows.Count, 1).End(xlUp).Row
If intLastRow <= 1 Then
' Überschriften
[A1].Value = "Betreff"
[B1].Value = "Datum Uhrzeit"
[C1].Value = "empfangen von"
[D1].Value = "gelesen"
[E1].Value = "Dateianhänge"
Rows(1).Font.Bold = True
End If
Set objPosteingang = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
' Hier wird jede neue Mail in die Liste aufgenommen
' es müßte dann eine If-Abfrage nach z.B. UCase(LEFT(.SenderName, 4)) = "JINX"
' statt .UnRead kommen
For Each objNewMail In objPosteingang.Items
With objNewMail
If .UnRead = True Then
intLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(intLastRow, 1).Value = .Subject
Cells(intLastRow, 2).Value = .ReceivedTime
Cells(intLastRow, 3).Value = .SenderName
Cells(intLastRow, 4).Value = Not .UnRead
Cells(intLastRow, 5).Value = .Attachments.Count
End If
End With
Next objNewMail
Columns("B:E").AutoFit
' Mappe wird gespeichert
ActiveWorkbook.Save
' Excel-Instanz wird geschlossen
xlApp.Application.Quit
' Freigabe
Set xlApp = Nothing
Set xlSheet = Nothing
End Sub
cu
jinx