Hallo!
Erfolgreich hab ich in Outlook eine Besprechung mit verschiedenen Teilnehmer angelegt. Manuell erledigen muß ich jetzt noch die Teilnehmer einzuladen (Knopf) und den Termin zu versenden.
Das es eine ganze Reihe von Besprechungen sind, die ich anlege, hab ich einen Code geschrieben, der mir alle Termine mit den jeweiligen Teilnehmern und dem Teilnahmestatus auflistet. (Funktioniert auch)
Bevor ich aber die Besprechung versende, möchte ich im Kalender vergleichen, ob die einzelnen Teilnehmer schon geblockt sind oder Zeit haben. Das geht über BusyStatus. (evtl auch über conflict(s)?)
Ich krieg´s aber ums verecken nicht hin auszulesen, ob der Termin an die Teilnehmer schon versandt worde ist!! Die Eigenschaft im Outlook lautet mailItem.Submitted.
Villeicht hat ja jemand von euch einen zündenen Gedanken?
Vielen Dank u. schönes WE!
Gruß, Marc
Das wesentliche Teilstück des Codes lautet wie folgt:
Sub Read_Control_Termin_to_Excel()
'Datumsabfage über Inputbox
'Verweis auf Outlook 11 Library im VB-Editor muss gesetzt sein
'Early Binding ab Outlook 2003 nicht möglich
'weil die Rückgabewerte der ITEM-Indexes zufällig ist und von der
'Installation abhängt !!
Dim myR As Integer, i As Integer
Dim startDate As Date, endDate As Date, recDate As Date, extDate As Date
Dim myOlApp As Object, myOlSpace As Object, myOlFolder As Object ', olFolderCalendar As Integer
Dim myOlDateRange As Object, sAppoint As Object
Dim extRecurr As Object
Dim strRecurr As String
'Datum vorschlagen
Select Case Weekday(Now, vbMonday)
Case Is > 5
recDate = Now + 3
Case Else
recDate = Now
End Select
'Datum abfragen
startDate = Format(DateValue(InputBox("Welches Datum soll abgefragt werden ?" & Chr$(13) & _
"Datum muss im Format ""01.01.2004"" eingeben werden", "Terminsuche", Format(recDate, "dd.mm.yyyy"))))
endDate = startDate + 30
'Deklaration
Set myOlApp = CreateObject("Outlook.Application")
Set myOlSpace = myOlApp.GetNamespace("MAPI")
Set myOlFolder = myOlSpace.GetDefaultFolder(9) 'olFolderCalendar
'Einträge ab Zeile 2
myR = 2
Sheets("Übersicht").Select
'Löscht alle zellen in der aktiven Tabelle
Cells.ClearContents
Cells.Interior.ColorIndex = xlNone
Cells(1, 1) = "Termin"
Cells(1, 2) = "Uhrzeit"
Cells(1, 3) = "Teilnehmerzahl"
Cells(1, 4) = "Zusagen"
Cells(1, 5) = "ohne RÜ"
Cells(1, 6) = "Absagen"
Set myOlDateRange = myOlFolder.Items.Restrict("[Start] >= '" & startDate & "' And [End] < & '" & endDate + 1 & "'")
Farbe = 35
For Each sAppoint In myOlDateRange
With sAppoint
If .Subject = "InfoSec-Schulung" Then
Cells(myR, 3) = .Recipients.Count & " Teilnehmer"
For empf = 1 To .Recipients.Count
'Termindaten eintragen
Cells(myR, 1) = Format(.Start, "dd.mm.yyyy")
Cells(myR, 2) = Format(.Start, "h:mm")
On Error Resume Next
Set myRecipient = myOlSpace.CreateRecipient(.Recipients(empf))
'Gebucht-Status auslesen
'ab dem Datum werden 31 Tage ausgelesen, jedes Zeichen zeigt dabei den gebucht-Status der angegeben Minuten
'60*24 zeigt also 1 Tag pro Zeichen, 15 zeigt eine Viertelstunde pro Zeichen
intervall = 30
Cells(myR, "H") = "'" & myRecipient.FreeBusy(.Start, intervall)
'Auf einen Tag beschränken
'Da immer 1 Tag ausgelesen wird, ist 1 Tag = Anzahl der Zeichen / 31
Cells(myR, "H") = "'" & Left(Cells(myR, "H"), Len(Cells(myR, "H")) / 31)
'Zeitraum eingrenzen:
'Beispiel 9:30 = 9,5 --> 0,5 Std/Zeichen --> Zeichen Nr 19
Zeit = Round(Cells(myR, 2) * 24 * 2, 2) / 2
Cells(myR, "H") = "'" & Mid(Cells(myR, "H"), Zeit / (intervall / 60) + 1, 1)
Debug.Print .Recipients(empf), .Recipients(empf).MeetingResponseStatus
Select Case .Recipients(empf).MeetingResponseStatus
Case 0
zu_absage = ", keine RÜ"
Cells(myR, 5) = .Recipients(empf)
zusatz = 2
Case 2, 3
zu_absage = ", Zusage"
Cells(myR, 4) = .Recipients(empf)
zusatz = 1
Case 4
zu_absage = ", Absage"
Cells(myR, 6) = .Recipients(empf)
zusatz = 3
Case Else
zu_absage = ", keine RÜ"
Cells(myR, 5) = .Recipients(empf)
zusatz = 1
End Select
'Formel zum sortieren einfügen
Cells(myR, 7).FormulaLocal = "=JAHR(A" & myR & ")&MONAT(A" & myR & ")& TAG(A" & myR & ")&RUNDEN(B" & myR & "*1000;0)+" & zusatz
Range(Cells(myR, 1), Cells(myR, 6)).Interior.ColorIndex = Farbe
myR = myR + 1
Next empf
Farbe = IIf(Farbe = 35, 39, 35)
End If
End With
Next