如何防止 Outlook 提醒时间过早或过晚？

例如，您的日常工作时间为上午 9:00 至下午 6:00，但您在上午 10:00 安排了一次预约，并在 Outlook 中设置了 2 小时的提醒。这样一来，提醒将在您上班前的上午 8:00 响起。另一方面，在特殊情况下，提醒甚至可能在半夜响起。这无疑会带来极大的不便，因此不少 Outlook 用户希望能够防止提醒过早或过晚弹出。下面我将为您介绍一个 VBA 宏，帮助您在 Outlook 中轻松解决这一问题。

要防止 Outlook 提醒过早或过晚，可以按照以下方法操作：

步骤 1：请同时按下 Alt+F11 组合键，即可打开 Microsoft Visual Basic for Applications 窗口。

步骤 2：在左侧窗格展开 Microsoft Outlook Objects，并在 ThisOutlookSession 中粘贴以下 VBA 宏代码。

VBA：防止 Outlook 中提醒时间过早或过晚

Public WithEvents g_CalendarItems As Outlook.Items
Public Sub Application_Startup()
Set g_CalendarItems = Outlook.Session.GetDefaultFolder(olFolderCalendar).Items
End Sub
Private Sub g_CalendarItems_ItemAdd(ByVal Item As Object)
CheckReminder Item
End Sub
Private Sub g_CalendarItems_ItemChange(ByVal Item As Object)
CheckReminder Item
End Sub
Sub CheckReminder(ByVal Item As Object)
On Error GoTo ProcError
Dim strProcName As String
strProcName = "CheckReminder"
reminderMaxHour = 20
reminderMinHour = 9
Dim aAptItem As Outlook.AppointmentItem
Set aAptItem = Item
If aAptItem.ReminderSet Then
Dim reminderDate As Date
reminderDate = aAptItem.Start - aAptItem.ReminderMinutesBeforeStart / (24 * 60)
reminderHour = (reminderDate - Int(reminderDate)) * 24
tolerance = 0.01 ' avoid floating point small diffs (little bit less than a min)
If reminderHour < reminderMinHour - tolerance Or reminderHour > reminderMaxHour + tolerance Then
' best guess, first try to advance to next minHour
reminderDateSuggestion = reminderDate + (reminderMinHour - reminderHour) / 24
' verify if first guess is valid
If reminderHour < reminderMinHour - tolerance And reminderDateSuggestion <= aAptItem.Start Then
' OK, first guess is valid, keep it
ElseIf reminderHour > reminderMaxHour Then
' go back to max hour (same day)
reminderDateSuggestion = reminderDate - (reminderHour - reminderMaxHour) / 24
Else
' go back to max hour (previous day)
reminderDateSuggestion = reminderDate - (reminderHour + 24 - reminderMaxHour) / 24
End If
rep = MsgBox("The Reminder time is out of specified working period. Would you like to change the Reminder time?" , vbQuestion + vbYesNoCancel)
If rep = vbCancel Then
aAptItem.Display
ElseIf rep = vbYes Then
aAptItem.ReminderMinutesBeforeStart = (aAptItem.Start - reminderDateSuggestion) * 24 * 60
aAptItem.Save
End If
End If
End If
ProcExit:
Exit Sub
ProcError:
MsgBox "Unanticipated error " & Err.Number & " " & Err.Description & vbCrLf & "In procedure: " & strProcName
End Sub

注意：您可以通过更改上述 VBA 代码中的以下参数，来指定您的工作时间段：
reminderMaxHour = 20
reminderMinHour = 9

步骤 3：保存此 VBA，并重新启动您的 Microsoft Outlook。

从现在开始，当您新建预约且提醒时间超出指定工作时段时，点击保存并关闭按钮后，将弹出对话框进行提醒。

在提醒时间早于指定的 reminderMinHour 时，请在对话框中点击是，系统会自动更改并将提醒时间调整为指定的 reminderMinHour。

如果提醒时间晚于指定的 reminderMaxHour，请在对话框中点击是，系统将自动更改提醒时间，并确保您在指定的 reminderMaxHour 收到提醒。

注意：此 VBA 代码可在 Outlook 2013 正常使用，但在 Outlook 2010 和 2007 中无法使用。

---

最佳办公效率工具

体验全新 Kutools for Outlook，畅享 100+ 强大功能！立即点击下载，不容错过！

🤖KUTOOLS AI：采用先进 AI 技术，轻松处理邮件，涵盖回复、摘要、优化、扩展、翻译及撰写等功能。

📧 邮件自动化：自动答复（支持 POP 和 IMAP）/定时发送邮件/发送邮件时按规则自动抄送密送/自动转发（高级规则）/自动添加称呼/自动将多收件人邮件拆分为单独信息……

📨 邮件管理：撤回邮件/按主题等条件拦截诈骗邮件/删除重复邮件/高级搜索/整合文件夹……

📁 附件增强：批量保存/批量分离/批量压缩/自动保存/自动拆离/自动压缩……

🌟 界面魔法：😊更多美观时尚表情/重要邮件到达时提醒您/最小化 Outlook 而不是直接关闭……

👍 一键精彩功能：带附件全部答复/反钓鱼邮件/🕘显示发送者当前时间时区……

👩🏼‍🤝‍👩🏻 联系人与日历：批量从选定邮件中提取添加联系人/将联系人组拆分为个人组/移除生日提醒……

在您的首选语言中畅享 Kutools —— 支持英语、西班牙语、德语、法语、中文等 40 多种语言！

一键解锁 Kutools for Outlook，告别等待，立即下载，让效率倍增！

Kutools for Outlook 功能列表      立即下载      前往购买

🚀 一键下载 — 即可获取全部 Office 加载项

强烈推荐：Kutools for Office（5 合 1）

一键下载五个安装包，即可同时获得 Kutools for Excel、Outlook、Word、PowerPoint 和 Office Tab Pro。立即点击下载！

• ✅ 一键便捷：只需一次操作，即可下载全部五个安装包。
• 🚀 轻松应对各类 Office 任务：随时按需安装所需插件，助您高效办公，不容错过！
• 🧰 包含：Kutools for Excel / Kutools for Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint

关于套件⬇ 下载套件💳 购买套件