|
Guten Morgen,
ich nutze den u.g. Code zum Auslesen von freigegebenen Kalender. Er funktioniert bei fast allen Personen. Nur bei einer Person kann ich die Bedingung des Zeitraums und die Ausweitung auf die Serientermine nicht gemeinsam nutzen. Bei einer Bedingung läuft der Code durch. Sobald ich beides nutze hängt sich der Code bei " For Each oAppt..." auf. Im Outlook erscheint folgende Nachricht:
Die Aktion konnte nicht beendet werden, das Posteingang nicht antwortet. Währlen Sie wechseln zu um Posteingang zu wechseln und das Problem zu lösen.
Wenn ich Wechseln zu Drücke geht nichts mehr, ich muss Outlook neu starten, dann bricht der VBA Code ab.
Wo könnte der Fehler sein?
Vielen Dank
Function test()
Dim myStart As Date
Dim myEnd As Date
Dim strRestriction As String
Set OL = CreateObject("Outlook.Application")
Set olNS = OL.GetNamespace("MAPI")
Set myRecipient = olNS.CreateRecipient("Test@gmx.de")
Set SharedFolder = olNS.GetSharedDefaultFolder(myRecipient, 9) 'Kommentar:9=Kalenderordner
Set oItems = SharedFolder.Items
myStart = Date
myEnd = DateAdd("d", 40, myStart)
strRestriction = "[Start] <= '" & Format$(myEnd, "mm/dd/yyyy hh:mm AMPM") _
& "' AND [End] >= '" & Format(myStart, "mm/dd/yyyy hh:mm AMPM") & "'"
oItems.Sort "[Start]"
oItems.IncludeRecurrences = True
For Each oAppt In oItems.Restrict(strRestriction)
Debug.Print "start:"; oAppt.Start & " " & oAppt.End & " sub: " & oAppt.Subject
Next
End Function
|