Narrowing down / speeding up search in extracted outlook shcedule - excel

Question

I am trying to find a specific subject in a shared outlook calendar on a specific date. The subject, the date and the shared calendar is passed as arguments. The script below works (I simplified it a bit for readability in this thread). BUT it is extremely slow since the "for" and "if" statement goes through all the schedules in all the dates. I got about 20 shared calendars to go through over 15 days time period; equating to about 300 times that the function is called (300 cells) in excel. This takes a huge amount of time to process, like an hour or or so. I speeded it up a little by exiting the "for" loop as soon as a match is found. But for those dates when there is no match, the for loop has to go through all the calendar item. And some calendar has huge number of schedules. Is there any way to actually only extract the schedules on the specified date, leaving the "for" loop to go through only handful of schedules on that day? Any help would be appreciated.
Function FindAttendance(xDate As Date, xSubject As String, xEmail As String) As Boolean
On Error GoTo ErrHand:
Application.ScreenUpdating = False
Const olFolderCalendar As Byte = 9
Dim olApp As Object: Set olApp = CreateObject("Outlook.Application")
Dim olNS As Object: Set olNS = olApp.GetNamespace("MAPI")
Dim olFolder As Object
Dim olApt As Object
Dim objOwner As Object: Set objOwner = olNS.CreateRecipient(xEmail)
Dim FromDate As Date
Dim ToDate As Date
FindAttendance = False
objOwner.Resolve
If objOwner.Resolved Then
Set olFolder = olNS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If
If olFolder.Items.Count = 0 Then Resume cleanExit
On Error Resume Next
For Each olApt In olFolder.Items
If olApt.Start = xDate Then
If (olApt.Subject = xSubject) Then
FindAttendance = True
Exit For
Else
End If
Else
End If
Next
On Error GoTo 0
Application.ScreenUpdating = True
cleanExit:
Application.ScreenUpdating = True
Exit Function
ErrHand:
Resume cleanExit
End Function

Answer 1

First of all, iterating over all items in the folder is not really a good idea. You need to use the Find/FindNext or Restrict methods of the Items class to get only items that correspond to your conditions.
Read more about that in the following articles:
How To: Retrieve Outlook calendar items using Find and FindNext methods
How To: Use Restrict method in Outlook to get calendar items
Second, don't use a straight comparison:
If (olApt.Subject = xSubject) Then
Instead, use the contains search criteria where a subject line may include a substring, not be equal. For example, the following query performs a phrase match query for keyword in the message subject:
filter = "#SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0037001E" _
& Chr(34) & " ci_phrasematch " & "'keyword'"
Third, you may combine the following conditions into a single search string:
If olApt.Start = xDate Then
If (olApt.Subject = xSubject) Then

Answer 2

Never loop through all items in a folder, especially if it is an online (non-cached folder), that is what Items.Find/FindNext and Items.Restrict are for. Use a query like
#SQL="http://schemas.microsoft.com/mapi/proptag/0x0E1D001F" = 'TheValue'
Note that the search query above is on the PR_NORMALIZED_SUBJECT_W MAPI property; searches on the OOM property Subject are flaky in OOM.
You can add more conditions with OR or AND connectors. Also note that a check like If olApt.Start = xDate will most likely fail since Date values are floats and the condition will never be satisfied because of the round-off errors - always use a range (e.g. < start + 1 sec and > start - 1 sec)