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

Author: Kelly Last Modified: 2025-05-07

例如，您每天从早上 9 点工作到下午 6 点，但现在您正在安排上午 10 点的约会，并在 Outlook 中为其添加了 2 小时的提醒。这意味着提醒将在您上班前的早上 8 点触发。另一方面，在某些特殊情况下，提醒可能会在半夜响起。这非常不方便，一些 Outlook 用户可能希望防止 Outlook 提醒过早或过晚。在这里，我将向您介绍一个 VBA 宏来解决这个问题。

Office Tab - 在 Microsoft Office 中启用标签页编辑和浏览，让工作变得轻松愉快。

阅读 Office Tab 的功能下载 Office Tab

立即解锁 Kutools for Outlook 的免费版本，永久享受超过 70 项功能的无限访问权限。

通过 AI 技术提升您的邮件处理效率，帮助您快速回复邮件、撰写新邮件、翻译消息等，更加高效地完成任务。
通过规则实现自动抄送密送、自动转发；无需 Exchange 服务器即可发送自动答复（外出）...
当您在密件抄送列表中回复所有人时，获得诸如答复的邮件为 BCC 时提醒等提示，并在忘记附件时收到提醒...
通过带附件回复（全部）、自动添加问候语或日期时间至签名或主题、批量回复邮件等功能提高邮件效率...
通过撤回邮件、附件工具（压缩所有附件、自动保存所有附件...）、删除重复邮件以及快速报告等功能简化邮件操作...

通过这些高级功能增强您的 Outlook 2024 - 2010 或 Outlook 365。享受 70 多种强大功能，提升您的邮件体验！

阅读 Kutools for Outlook 的所有功能下载免费版本

为了防止 Outlook 提醒过早或过晚，您可以按照以下步骤操作：

步骤 1：同时按下 Alt + F11 键打开 Microsoft Visual Basic for Applications 窗口。

步骤 2：在左侧窗格中展开 Microsoft Outlook 对象，并将以下 VBA 宏粘贴到 ThisOutlookSession 中。

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。

从现在开始，当创建的约会提醒时间超出您指定的工作时间段时，点击“保存并关闭”按钮后会弹出一个对话框提醒您。