Установите напоминания для повторяющихся встреч

Question

Я пытаюсь установить напоминания для повторяющихся встреч.

 If objAppointment.ReminderSet = False Then
     If objAppointment.IsRecurring Then
         'Dim objRecurrencePattern As RecurrencePattern
         'Set objRecurrencePattern = objAppointment.GetRecurrencePattern
         'Set objAppointment = objRecurrencePattern.GetOccurrence(objAppointment.Start)
         objAppointment.ReminderOverrideDefault = True
     End If

     objAppointment.ReminderSet = True
     objAppointment.ReminderMinutesBeforeStart = 15 ' Enter your default time
     objAppointment.Save
     Debug.Print "Reminder set for '" & objAppointment.Subject & "'."
 End If

Я нашел это сообщение на форуме MS .

Кажется, свойства напоминания установлены правильно в отладчике VBA, но если я проверяю встречу в календаре, напоминание все еще не установлено / не действует.

Answer 1

Если вы имеете дело с экземпляром повторяющейся встречи или исключением (проверьте свойство AppointmentItem.RecurrenceState), установите напоминание о главной встрече, полученной из свойства AppointmentItem.Parent.

Answer 2

Если собрание повторяется, вам нужно отредактировать Все события <-> Родительское собрание Смотрите код здесь https://gist.github.com/tdalon/60a746cfda75ad191e426ee421324386

Sub CheckTodayReminders()
    ' https://www.datanumen.com/blogs/quickly-send-todays-appointments-someone-via-outlook-vba/
    Dim objAppointments As Outlook.Items
    Dim objTodayAppointments As Outlook.Items
    Dim strFilter As String
    Dim objAppointment As Outlook.AppointmentItem ' Object

    Set objAppointments = Application.Session.GetDefaultFolder(olFolderCalendar).Items
    objAppointments.IncludeRecurrences = True
    objAppointments.Sort "[Start]", False ' Bug: use False/descending see https://social.msdn.microsoft.com/Forums/office/en-US/919e1aee-ae67-488f-9adc-2c8518854b2a/how-to-get-recurring-appointment-current-date?forum=outlookdev


    'Find your today's appointments
    strFilter = Format(Now, "ddddd")
    'strFilter = "2019-03-07"
    strFilter = "[Start] > '" & strFilter & " 00:00 AM' AND [Start] <= '" & strFilter & " 11:59 PM'"
    Set objTodayAppointments = objAppointments.Restrict(strFilter)

    For Each objAppointment In objTodayAppointments
        Debug.Print "Check Reminder for '" & objAppointment.Subject & "'..."

        If objAppointment.IsRecurring Then

            Set objAppointment = objAppointment.Parent

        End If

        If objAppointment.ReminderSet = False Then


            objAppointment.ReminderSet = True
            objAppointment.ReminderMinutesBeforeStart = 15 ' Enter your default time
            objAppointment.Save
            Debug.Print "Reminder set for '" & objAppointment.Subject & "'."
        End If

    Next
    ' MsgBox "Meeting reminders were checked!"

End Sub