有没有办法通过VBA在所有即将到来的会议上强制执行outlook提醒？

Sub SetRemindersForUpcomingMeetings()
    Dim objNamespace As Outlook.Namespace
    Dim objAppointments As Outlook.Items
    Dim objAppointment As Outlook.AppointmentItem
    Dim objExplorer As Outlook.Explorer
    Dim objSelection As Outlook.Selection
    
    ' 获取当前Outlook应用程序的命名空间
    Set objNamespace = Application.GetNamespace("MAPI")
    
    ' 获取所有会议的集合
    Set objAppointments = objNamespace.GetDefaultFolder(olFolderCalendar).Items
    
    ' 设置筛选条件，只选择即将到来的会议
    objAppointments.IncludeRecurrences = True
    objAppointments.Sort "[Start]"
    objAppointments.Restrict "[Start] >= '" & Format(Now, "ddddd h:nn AMPM") & "'"
    
    ' 遍历会议集合，为每个会议设置提醒
    For Each objAppointment In objAppointments
        objAppointment.ReminderSet = True
        objAppointment.ReminderMinutesBeforeStart = 15 ' 设置提前提醒时间（单位：分钟）
        objAppointment.Save
    Next objAppointment
    
    ' 显示会议窗口
    Set objExplorer = Application.ActiveExplorer
    Set objSelection = objExplorer.Selection
    objSelection.ClearSelection
    objExplorer.CurrentFolder = objNamespace.GetDefaultFolder(olFolderCalendar)
    objExplorer.ClearSearch
    objExplorer.Activate
    
    ' 释放对象
    Set objAppointment = Nothing
    Set objAppointments = Nothing
    Set objNamespace = Nothing
    Set objExplorer = Nothing
    Set objSelection = Nothing
End Sub