Bestätigungs-/und Absagemails auswerten

Hallo zusammen,

da ich gerade ebenfalls vor diesem Problem gestanden habe (spezielle Anforderung – wozu man sowas brauchen kann, ist mir ein wenig schleierhaft (bürokratischer Aufwand?)) und Google und Co. auch nix in der Hinsicht ausgespuckt haben (außer diesem Thread), war eben selbermachen angesagt.

Funktion:
Der angeklickte Termin (oder auch geöffnet -> Doppelklick) steht im Makrofokus und wird ausgewertet, das Ergebnis in eine csv-Datei geschrieben und diese wird mit Excel geöffnet.
Makro kann man ja auf eine Taste legen und in die Menüleiste einpflanzen…
Man sehe es mir nach, daß ich den Quellcode nicht sonderlich kommentiert habe 😉

[code]
Declare Function ShellExecute Lib \”shell32.dll\” Alias \”ShellExecuteA\” _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As _
String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub TerminAuswertung()

Dim objApp As Application
Dim objNS As NameSpace
Dim objCalendar As MAPIFolder
Dim objItem As AppointmentItem
Dim strSubject As String
Dim ObjRecipient As Recipient
Set objApp = CreateObject(\”Outlook.Application\”)
Set objNS = objApp.GetNamespace(\”MAPI\”)
Set objCalendar = objNS.GetDefaultFolder(olFolderCalendar)
Dim antwort As String
Dim anzeigen

Open \”C:\\TEMP\\AusgabeCalenderTest.csv\” For Output As #1

For Each objItem In Application.ActiveExplorer.Selection
With objItem

Print #1, (\”Titel: \” & .Subject & vbCrLf)
Print #1, (\”Am: \” & .Start & \” – \” & .End & vbCrLf)
Print #1, (\”Dauer: \” & IIf(.Duration = 1440, \”Ganztägig\”, .Duration & \” Minuten\”) & vbCrLf)
Print #1, (\”Teilnehmer: \” & .Recipients.Count)

If .Recipients.Count > 0 Then
For Each ObjRecipient In .Recipients

Select Case ObjRecipient.MeetingResponseStatus
Case 3
antwort = \”Zugesagt;\”
Case 4
antwort = \”Abgelehnt;\”
Case 0
antwort = \”Keine Antwort;\” \’Normal
Case 5
antwort = \”Keine Antwort;\”
Case 1
antwort = \”Keine Antwort;\”
Case 2
antwort = \”Unter Vorbehalt;\”
End Select

Print #1, (ObjRecipient.Name & \”;\” & antwort)
Next

End If

End With
Next
Close #1
ShellExecute 0&, \”open\”, \”C:\\TEMP\\AusgabeCalenderTest.csv\”, vbNullString, vbNullString, vbNormalFocus
End Sub

\’ \”Body: \” & .Body & vbCrLf & <- falls er nötig sein sollte [/code] HTH code4u 🙂