Outlook gebucht-Status auslesen?
Marc
Um Schulungstermine zu vergeben hab ich eine Reihe Namen, die gruppiert einen Termin in Outlook bekommen.
In Outlook (leider per Hand) wird der Termin von mir editiert, alle Namen als Teilnehmer identifiziert und eingeladen. (Noch nicht gesendet!)
Im Excel hab ich ein Makro geschrieben, was mir die Termine mit allen Teilnehmer wieder auslesen kann. Status der Teilnahme ist "ohne Rückmeldung" (logisch, hab ja noch nix geschickt)
Gibt es eine Möglichkeit, auszulesen, ob sich der von mir für die Person anvisierte Termin mit einem weiteren Termin überschneidet? Dann könnte ich schon sofort einen anderen Termin zuweisen.
Mit den erläuterungen sieht der code bisher wie folgt aus:
Vielen Dank für´s "reindenken"
Gruß, Marc
Sub Read_Control_Termin_to_Excel()
'by Ramses
'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] ", Absage" Then
x = x & a & Chr(10)
Else
y = y & .Recipients(empf) & Chr(10)
absagen = absagen + 1
End If
'Debug.Print "====================================================="
'Teilnehmer
'Cells(myR, 3) = .Recipients.Count - absagen
'Cells(myR, 6) = .Body
myR = myR + 1
Next empf
End If
End With
Next
Columns("d:f").ColumnWidth = 50
Columns("a:f").AutoFit
lz = Cells(Rows.Count, "g").End(xlUp).Row
Range("a2:g" & lz).Sort key1:=Range("g2"), key2:=Range("d2"), key3:=Range("e2")
Rows("2:" & lz).AutoFit
Range("g:g").ClearContents
'Variablen leeren
Set myOlApp = Nothing
Set myOlSpace = Nothing
Set myOlFolder = Nothing
'MsgBox "Alle Termine für den " & startDate & " eingelesen!"
End Sub
Anzeige