.RESTRICT returning birthdays regardless of the filtering date

[oliv-]

Hi,

It has been several times that the restrict method returns birthdays, which does not match my filter

What is the reason?

Option Explicit
Sub ContactDateCheck()

    Dim myItems As Outlook.Items
    Dim currentAppointment As Object
    Dim myAppointments As Object
    Dim strDate
    Dim strRestriction
    Set myItems = Application.GetNamespace("mapi").GetDefaultFolder(olFolderCalendar).Items
    strDate = VBA.Format(Date - 1, "Short Date")
    strRestriction = "(([Start] >= '" & strDate & " 12:00 am' AND [Start] <= '" & strDate & " 11:59 pm')"
    strRestriction = strRestriction & " OR ([End] > '" & strDate & " 12:00 am' AND [End] <= '" & strDate & " 11:59 pm')"
    strRestriction = strRestriction & " OR ([Start] < '" & strDate & " 12:00 am' AND [End] > '" & strDate & " 11:59 pm'))"
    strRestriction = strRestriction & " AND [Duration] > 0"
   
    If strDate = "" Then strRestriction = "[Start] = 1"    'no result
    Set myAppointments = myItems.Restrict(strRestriction)
    myAppointments.sort "[Start]"
    ' myAppointments.IncludeRecurrences = True
   MsgBox myAppointments.count
    For Each currentAppointment In myAppointments
        Dim Datestart As Date
        Datestart = strDate
        If currentAppointment.Class = olAppointment Then 'And currentAppointment.Start >= Datestart Then
            ' écrit à partir de E21 verticalement pour les rendez vous successifs
            MsgBox currentAppointment.subject & vbCr & currentAppointment.Start & vbCr & currentAppointment.End
           
        End If
    Next

End Sub

 

[oliv-]

Can anybody confirm the BUG ?
If you want to test it.
Paste the code in a module.
Add a contact with a birthday.
Run it

 

[Diane Poremsky]

Unless I'm missing something, the filter is going for all day events and nothing in it is specifically removing birthdays. It should find all all-day events - birthday and otherwise.

It should find any recurring all day event, not just birthdays (and anniversaries) - they actually span from start to end, not just one day a year.
This will remove recurring events -
strRestriction = strRestriction & " AND [IsRecurring] = False"

 

[oliv-]

Unless I'm missing something, the filter is going for all day events and nothing in it is specifically removing birthdays. It should find all all-day events - birthday and otherwise.

It should find any recurring all day event, not just birthdays (and anniversaries) - they actually span from start to end, not just one day a year.
This will remove recurring events -
strRestriction = strRestriction & " AND [IsRecurring] = False"

Hi Diane,
Thank you for your help.
If birthday is in my query period, ok i want it . But in this case all birtdays are in the result

 

[Diane Poremsky]

i see what the problem is - the Or asks for start before yesterday and end after... that covers all birthdays. one or basically cancels the other one out.

strRestriction = strRestriction & " OR ([End] > '" & strDate & " 12:00 am' AND [End] <= '" & strDate & " 11:59 pm')"
strRestriction = strRestriction & " OR ([Start] < '" & strDate & " 12:00 am' AND [End] > '" & strDate & " 11:59 pm'))"

 

[Diane Poremsky]

This version gets all appointments yesterday. The first line that starts yesterday or later and before today. This works on all non-recurring. Then we do an OR to get start dates after yesterday that end before today for recurring events.

Sub ContactDateCheck()
  Dim myItems As Outlook.Items
  Dim currentAppointment As Object
  Dim myAppointments As Object
  Dim strDate As Date
  Dim strRestriction

  Set myItems = Application.GetNamespace("mapi").GetDefaultFolder(olFolderCalendar).Items

  myItems.Sort "[Start]"
  strDate = Format(Date - 1, "Short Date")
  myItems.IncludeRecurrences = True

 
  strRestriction = "(([Start] >= '" & strDate & "' AND [start] <= '" & Date & "')"
  strRestriction = strRestriction & " OR ([Start] >= '" & strDate - 1 & "' And [End] <= '" & Date & "'))"
  strRestriction = strRestriction & " AND [Duration] > 0"


  strRestriction = strRestriction & " AND [Duration] > 0"

  Debug.Print strRestriction
  Set myAppointments = myItems.Restrict(strRestriction)

  Debug.Print myAppointments.Count
  For Each currentAppointment In myAppointments
  Dim Datestart As Date
  Datestart = strDate
  If currentAppointment.Class = olAppointment Then
  Debug.Print currentAppointment.Subject & vbTab & currentAppointment.Start & vbTab & currentAppointment.End

  End If
  Next

End Sub

Edited: updated it for all day events.

 

[Diane Poremsky]

I forgot to test it with all day non-recurring - if we need ot get all day events, we don't need to look for recurring, just need the right filter.

Note the start date is a day early - needed to do that to get the all day events.

Gets timed appointments:
strRestriction = "(([Start] >= '" & strDate & "' AND [start] <= '" & Date & "')"

Get all day events - either recurring or not.
strRestriction = strRestriction & " OR ([Start] >= '" & strDate - 1 & "' And [End] <= '" & Date & "'))"


If you wanted to limit it to recurring or all day, you'd use either of these
strRestriction = strRestriction & " OR ([Start] >= '" & strDate - 1 & "' And [End] <= '" & Date & "' And [IsRecurring] = True)"
strRestriction = strRestriction & " OR ([Start] >= '" & strDate - 1 & "' And [End] <= '" & Date & "' And [AllDayEvent] = true)"

 

[oliv-]

This version gets all appointments yesterday. The first line that starts yesterday or later and before today. This works on all non-recurring. Then we do an OR to get start dates after yesterday that end before today for recurring events.

Sub ContactDateCheck()
  Dim myItems As Outlook.Items
  Dim currentAppointment As Object
  Dim myAppointments As Object
  Dim strDate As Date
  Dim strRestriction

  Set myItems = Application.GetNamespace("mapi").GetDefaultFolder(olFolderCalendar).Items

  myItems.Sort "[Start]"
  strDate = Format(Date - 1, "Short Date")
  myItems.IncludeRecurrences = True

  strRestriction = "(([Start] >= '" & strDate & "' AND [start] <= '" & Date & "')"
  strRestriction = strRestriction & " OR ([Start] >= '" & strDate - 1 & "' And [End] <= '" & Date & "'))"
  strRestriction = strRestriction & " AND [Duration] > 0"

  strRestriction = strRestriction & " AND [Duration] > 0"

  Debug.Print strRestriction
  Set myAppointments = myItems.Restrict(strRestriction)

  Debug.Print myAppointments.Count
  For Each currentAppointment In myAppointments
  Dim Datestart As Date
  Datestart = strDate
  If currentAppointment.Class = olAppointment Then
  Debug.Print currentAppointment.Subject & vbTab & currentAppointment.Start & vbTab & currentAppointment.End

  End If
  Next

End Sub

Edited: updated it for all day events.

Hi Diane,

With your code above, i get nothing !

Perhaps it's because i'm French

I have updating my code with a short restrict filter :

Sub ContactDateCheckV2()

    Dim myItems As Outlook.Items
    Dim currentAppointment As Object
    Dim myAppointments As Object
    Dim strDate
    Dim strRestriction
    Set myItems = Application.GetNamespace("mapi").GetDefaultFolder(olFolderCalendar).Items
    strDate = VBA.Format(Date - 1, "Short Date")
    strRestriction = "(([Start] >= '" & strDate & " 12:00 am' ))"
    strRestriction = strRestriction & " AND [Duration] > 0"

    Debug.Print strRestriction

    If strDate = "" Then strRestriction = "[Start] = 1"    'no result
    Set myAppointments = myItems.Restrict(strRestriction)
    myAppointments.sort "[Start]"
    ' myAppointments.IncludeRecurrences = True
    MsgBox myAppointments.Count
    For Each currentAppointment In myAppointments
        Dim Datestart As Date
        Datestart = strDate
        If currentAppointment.Class = olAppointment Then    'And currentAppointment.Start >= Datestart Then
            Debug.Print currentAppointment.subject & vbTab & currentAppointment.Start & vbTab & currentAppointment.End
        End If
    Next
End Sub

and i get

(([Start] >= '27/01/2016 12:00 am' )) AND [Duration] > 0
Anniversaire de Mimi 10/11/1970 11/11/1970
Anniversaire de Sauvage,Fred 24/03/1971 25/03/1971
Anniversaire Dominique S. 05/08/2007 07/08/2007
Anniversaire Dominique S. 05/08/2007 06/08/2007
Anniversaire de VERO 17/02/2009 18/02/2009
Anniversaire de SEB 19/02/2009 20/02/2009
Anniversaire de Juju 23/02/2009 24/02/2009
Anniversaire de Fanny 26/04/2009 27/04/2009
Anniversaire de Mary 21/01/2010 22/01/2010
Anniversaire de jean luc 20/03/2010 21/03/2010
Anniversaire de anne 24/05/2010 25/05/2010
Anniversaire de Matthew 21/06/2010 22/06/2010
Anniversaire de Peggy 02/08/2010 03/08/2010
FIBRE 28/01/2016 09:30:00 28/01/2016 12:30:00
REVUE DES AMELIORATIONS 01/02/2016 14:30:00 01/02/2016 15:30:00
Premiére reunion Utilisateurs OBIEE 08/02/2016 14:00:00 08/02/2016 16:00:00
Mis(e) à jour: REUNION CADRES. 08/10/2018 10:00:00 08/10/2018 12:00:00

and the same for
strRestriction = "(([Start] >= '" & strDate & "' ))"

 

[Diane Poremsky]

language shouldn't matter for dates and fields. Add a debug.print strdate & " " & date after you set the date and verify the formats are correct.

You should dim the date string as date though -
Dim strDate As Date
This will allow you to add or subtract days from the date within the filter. Or you could just use Date instead.

Duration isn't necessary, unless you actually create 0 length appointments and need to exclude them. It is one way to filter out all day or multiday events (using < 24)

This filter gets me 636 - all holidays and who knows what else (too many to see in the immediate window).
strRestriction = "(([Start] >= '" & strDate & " 12:00 am' ))"
strRestriction = strRestriction & " AND [Duration] > 0"

This filter returns just the timed events yesterday & all day events (on the wrong date)-
strRestriction = "(([Start] >= '" & strDate & "' AND [start] <= '" & Date & "')"
strRestriction = strRestriction & " OR ([Start] >= '" & strDate & "' And [End] <= '" & Date & "'))"
strRestriction = strRestriction & " AND [Duration] > 0"

client- new and old 1/27/2016 10:00:00 AM 1/27/2016 11:00:00 AM
Work 1/27/2016 1:30:00 PM 1/27/2016 5:00:00 PM
All Day 28 1/28/2016 1/29/2016 <== one day event - outlook uses 12 AM the next day as the end date
Becky Birthday 1/28/2016 1/29/2016

This gets all day events - unfortunately, it gets both yesterday and today but it's the most complete
strRestriction = "(([Start] >= '" & strDate & "' AND [start] <= '" & Date & "')"
strRestriction = strRestriction & " OR ([Start] >= '" & strDate & "' And [End] <= '" & Date & "')"
strRestriction = strRestriction & " OR ([Start] >= '" & strDate - 1 & "' And [End] <= '" & Date & "' And [AllDayEvent] = true)"
strRestriction = strRestriction & ") AND [Duration] > 0"
All Day 1/27/2016 1/28/2016
Recurring 1/27/2016 1/28/2016
client - new and old 1/27/2016 10:00:00 AM 1/27/2016 11:00:00 AM
Work 1/27/2016 1:30:00 PM 1/27/2016 5:00:00 PM
All Day 28 1/28/2016 1/29/2016
Becky Birthday 1/28/2016 1/29/2016

I don't know if you can get all day events and birthdays on the correct date.
This:
strRestriction = "(([Start] >= '" & strDate & "' AND [start] <= '" & Date & "')"
strRestriction = strRestriction & " OR ([Start] >= '" & strDate - 4 & "' And [End] <= '" & Date - 1 & "' And [AllDayEvent] = true)"
strRestriction = strRestriction & ") AND [Duration] > 0"

Results in
(([Start] >= '1/27/2016' AND [start] <= '1/28/2016') OR ([Start] >= '1/23/2016' And [End] <= '1/27/2016' And [AllDayEvent] = true)) AND [Duration] > 0

gets an old multiday event and one tomorrow but not the birthday (recurring) today or the two all day events yesterday.
test 1/25/2016 1/27/2016 <== this is a 2 day event, 25 & 26.
client- new and old 1/27/2016 10:00:00 AM 1/27/2016 11:00:00 AM
Work 1/27/2016 1:30:00 PM 1/27/2016 5:00:00 PM
All Day 28 1/28/2016 1/29/2016 <== no idea why it got this one