Dim importDatum As Date
importDatum = DLookup("importDatum", "TblApp") 'the date from which the importing should start'
Dim ol As Object
Set ol = CreateObject("Outlook.Application")
Dim objitems As Variant
Set objitems = ol.GetNamespace("MAPI").GetDefaultFolder(9).Items
Dim c As Variant
objitems.Sort "[Start]"
objitems.IncludeRecurrences = True
Set objitems = objitems.Restrict("[Start] <= '" & Format(Date, "ddddd") & " 11:59 PM' AND [End] > '" & Format(importDatum, "ddddd") & " 12:00 AM'")
Set objitems = objitems.Restrict("not [Categories] = 'geen kilometers'")
'Set objitems = objitems.Restrict("[AllDayEvent] = False") 'this seems to remove all appointments always, but this can be fixed in the loop i use.
Dim counter As Integer
counter = 0
For Each c In objitems
counter = counter + 1
If c.categories = "geen kilometers" Then
MsgBox ("test")
End If
Next
Dim i As Integer
i = 1
Do While i <= counter
Set c = objitems.Item(i)
'do stuff'
Loop
|