Lasst mal die Schleifen über alle Termine weg...
10.08.2009 16:41:42
Ramses
Hallo
... das kostet doch nur unnötig Zeit.
Verwendet lieber die "Restrict"-Methode
Sub Get_scheduled_Appointments()
' Verweis auf MS Outlook Library der Version 10, 11 oder 12 setzen
' (C) Ramses
Dim strBeginn As String, strEnde As String
Dim myOutApp As Object
Dim objKalender As Object, objTermine As Object
Dim objTerminauswahl As Object, objTermin As AppointmentItem
Dim strBetreff As String, strStart As String
Dim strGanztag As String, tmpMessage As String
On Error GoTo Terminliste_Error
strBeginn = InputBox(Prompt:="Anfangsdatum:", Title:="Terminliste", Default:=VBA.Format(Now, "dd.mm.yyyy"))
If IsDate(strBeginn) Then
'Default = Heute + 7 Tage
strEnde = InputBox(Prompt:="Enddatum:", Title:="Terminliste", Default:=VBA.Format(Now + 7, "dd.mm.yyyy"))
If IsDate(strEnde) Then
Set myOutApp = CreateObject("Outlook.Application")
Set objKalender = myOutApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
Set objTermine = objKalender.Items
objTermine.Sort "[Start]"
objTermine.IncludeRecurrences = True
Set objTerminauswahl = objTermine.Restrict("[Start] >= '" & strBeginn & " 00:00'" & "AND [Start] <= '" & strEnde & " 23:59'")
If objTerminauswahl Is Nothing Then
MsgBox "Kein Termin in diesem Zeitraum", vbOKOnly + vbInformation, "Alles Frei"
Exit Sub
End If
tmpMessage = "Folgende Termine sind im Zeitraum von: " & strBeginn & " bis " & strEnde & " bereits eingetragen:" & vbCrLf
For Each objTermin In objTerminauswahl
With objTermin
strBetreff = .Subject
strStart = .start
strGanztag = .AllDayEvent
tmpMessage = tmpMessage & strBetreff & "," & strStart & ", Ganzer Tag:" & strGanztag & vbCrLf
End With
Next objTermin
MsgBox tmpMessage
End If
End If
Terminliste_End:
Exit Sub
Terminliste_Error:
MsgBox Prompt:="Es ist ein Fehler aufgetreten..." & vbCrLf & "(" & Err.Number & "): " & Err.Description
Resume Terminliste_End
End Sub
Das ganze könntest du jetzt in eine externe Boolean Funktion auslagern, die WAHR oder FALSCH für den Termin ausgibt, und innerhalb deines Makros verwendet werdenkann
Gruss Rainer