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
      End With
   End If
End Sub

Open in new window

Many thanks in advance

Hopeful Kiwi
Mark DalleyInformation AnalystAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Karen FalandaysTraining SpecialistCommented:
Hello Kiwi. there is a View button in Outlook that lets you view the next seven days. Is there a way to incorporate that in a toolbar?
Mark DalleyInformation AnalystAuthor Commented:
Hi Karen

Thanks for your suggestion. I must admit that I have never played with toolbars. It might be possible to do as you suggest, but I don;t think it is the way to go in this case because I want to do the whole operation from the Access environment, not from Outlook.


Hopeful Kiwi

(PS. My apologies everyone for letting this question lie idle for so long.)
Mark DalleyInformation AnalystAuthor Commented:
Hi everyone

I've finally sussed it - at least, I have a solution which works. To select a subset of appointments within a given date range, do the following:

1. When specifying your date range, use American (U.S.) format, for example:
      strRestriction = "[Start] >= '" & _
         Format$(datStart, "mm/dd/yyyy h:mm AMPM") _
         & "' AND [End] <= '" & _
         Format$(datEnd, "mm/dd/yyyy h:mm AMPM") & "'"

Open in new window

2. You will presumably want to sort the items by start date/time, Do this first:
      Set oItems = oCalendar.Items
      oItems.Sort "[Start]"

Open in new window

3. Also, you will presumably want to include recurring appointments if these exist. Specify this next:

      oItems.IncludeRecurrences = True

Open in new window

According to the help, IncludeRecurrences only works either on an unsorted list or one sorted by [Start] in ascending order!

3. Finally, apply the filter:

        Set oItemsInDateRange = oItems.Restrict(strRestriction)

Open in new window

The help for the Items.IncludeRecurrences property (at least for Outlook 2010), also has some other interesting comments about undefined counts being possible for recurring appointments with no end date.

I hope this helps someone else!

Hopeful Kiwi

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Mark DalleyInformation AnalystAuthor Commented:
No real answers forthcoming from elsewhere.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.