Display Outlook calendar appointments due in the next seven days

Hello Experts

I want to list the appointments in my Outlook calendar that will occur in the next 7 days using Access VBA, displaying them in an unbound text box on a form.

The Access form bit is fine, and I can access the relevant Calendar folder using the Outlook object model. I am however rather new to the Outlook way of doing things. (This whole business of property tags seems needlessly obscure to me, but that's a slight aside).

The fun starts when I try to narrow down the selection of appointment items. I want to do two rounds of restricting. The first, which doesn't seem to work as there are appointments going back to October 2017, is to select appointmants in the next 7 days from today. The next (which does work) is to eliminate appointment subjects other than those containing the string "team".

Can anyone tell me what I am doing wrong by looking at the code below? I suspect it's some trivial problem with the date syntax but have no idea what it is. In case it's relevant, Access displays dates in the UK standard dd/mm/yyyy format on my system.

Sub FindAppts2()

   Dim myStart As Date
   Dim myEnd As Date
   Dim ons As outlook.NameSpace
   Dim oFldrBase As outlook.Folder
   Dim oCalendar As outlook.Folder
   Dim oItems As outlook.Items
   Dim oItemsInDateRange As outlook.Items
   Dim oFinalItems As outlook.Items
   Dim oAppt As outlook.AppointmentItem
   Dim strRestriction As String

   Set ons = outlook.GetNamespace("MAPI")
   ' pick up the relevant email folder from the database Control table - works fine
   Set oFldrBase = ons.Folders(Access.DFirst("DoSEmailFolder", "Control"))
   ' get reference to the calendar
   Set oCalendar = oFldrBase.Folders("Calendar")
   If adhIsOpen("DoSMain", acForm) Then
      With Forms("DoSMain")   ' write in the txtUpcoming text box on the Access DoSMain form.
         .txtUpcoming = ""
         
         myStart = Date
         myEnd = DateAdd("d", 7, myStart)

         .txtUpcoming = .txtUpcoming & "Start:" & vbTab & myStart & vbCrLf
         .txtUpcoming = .txtUpcoming & "End:" & vbTab & myEnd & vbCrLf

         'Construct filter for the next 7-day date range
         'cribbed from internet example, but looks plausible
         '(I am still getting to know the Outlook way of doing things).
         strRestriction = "[Start] >= '" & _
            Format$(myStart, "yyyy/mm/dd hh:mm AMPM") _
            & "' AND [End] <= '" & _
            Format$(myEnd, "yyyy/mm/dd hh:mm AMPM") & "'"
         'Write the restriction string out to the text box, just so we can see it
         .txtUpcoming = .txtUpcoming & strRestriction & vbCrLf
         
         Set oItems = oCalendar.Items
         oItems.IncludeRecurrences = True
         oItems.Sort "[Start]"
         'Get new supposedly smaller collection by doing a Restrict the Items collection
         'for the 7-day date range
         Set oItemsInDateRange = oItems.Restrict(strRestriction)
         oItemsInDateRange.Sort "[Start]"
         
         'Construct filter for Subject containing 'team'. THIS SEEMS TO WORK.
         Const PropTag  As String = "http://schemas.microsoft.com/mapi/proptag/"
         strRestriction = "@SQL=" & Chr(34) & PropTag _
            & "0x0037001E" & Chr(34) & " like '%team%'"
         'Write the restriction string out to the text box, just so we can see it
         .txtUpcoming = .txtUpcoming & strRestriction & vbCrLf
         'Restrict the last set of filtered items for the subject
         Set oFinalItems = oItemsInDateRange.Restrict(strRestriction)
         'Sort and Debug.Print final results
         For Each oAppt In oFinalItems ' has appointments going back to 2011!!
            .txtUpcoming = .txtUpcoming & oAppt.Start & "  " & oAppt.Subject & vbCrLf
         Next
      End With
   End If
End Sub

Select allOpen in new window

Many thanks in advance

Hopeful Kiwi