Outlook Kalender-Einträge prüfen und speichern

Private Sub CheckOlCalendarAccess()
Dim olNameSpace As Object
Dim olApp As Object
Dim olFolder As Object
Dim olItem As Object
Dim dteStart As Date
Dim dteEnd As Date
Dim folderID As String
folderID = Tabelle5.Cells(2, 10)
Set olApp = CreateObject("Outlook.Application")
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olFolder = olApp.GetNamespace("Mapi").GetFolderFromID(folderID)
dteStart = DTPicker2.Value
dteEnd = DTPicker3.Value
' [IsRecurring] = False ignoriert Termin-Serien wie Geburtstage und Jahrestage
' [Start] ... Startdatum allerdings mit Uhrzeit
' [End] ... Enddatum mit Uhrzeit
Set olItem = olFolder.Items.Find("[Subject]=""" & cb_impl & """ (EU) AND ([Start]>=""" &  _
dteStart & """ AND [End]=""" & dteStart & """ AND [End]=""" & dteEnd & """)""")
Do Until TypeName(myItem) = "Nothing"
With olItem
ListBox2.addItem (.Subject)
ListBox2.List(ListBox2.ListCount - 1, 1) = .Start
ListBox2.List(ListBox2.ListCount - 1, 2) = .End
End With
Set myItem = olFolder.Items.FindNext
Loop
Set olItem = Nothing
Set olFolder = Nothing
Set olApp = Nothing
Set olNameSpace = Nothing
End Sub