设置定期约会提醒

时间:2019-04-02 09:05:42

标签: vba outlook outlook-vba

我正在尝试为定期约会设置提醒。

 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

我找到了this post in MS forum

提醒属性似乎已在VBA调试器中正确设置,但如果我在日历中检查约会,则提醒仍未设置/有效。

2 个答案:

答案 0 :(得分:2)

如果要处理重复约会或异常的实例(检查AppointmentItem.RecurrenceState属性),请对从AppointmentItem.Parent属性检索的主约会设置提醒。

答案 1 :(得分:0)

如果会议要定期召开,则必须编辑所有事件<->父会议 在此处查看代码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