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

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

CodePudding user response：

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)

CodePudding user response：

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:

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