如何在 Outlook 中忙碌时自动回复收到的邮件？

Author: Sun Last Modified: 2025-07-31

有时，您希望在一段时间内忙碌时自动回复 Outlook 中收到的邮件。但是，Outlook 并没有内置功能可以处理这项任务，不过，这里我有一个 VBA 代码可以解决这个问题。

使用 VBA 代码在忙碌时自动回复

以下是一个 VBA 代码，当您的 Outlook 日历中有预约时，它将自动回复；如果日历中没有任何内容，它将停止自动回复。

1. 按 Alt + F11 键打开 Microsoft Visual Basic for Applications 窗口。

2. 在 Project1 窗格中双击 ThisOutlookSession，复制并将以下代码粘贴到脚本中。

VBA：在日历忙碌时自动回复

Public WithEvents xInboxItems As Outlook.Items

Private Sub Application_Startup()
Set xInboxItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub xInboxItems_ItemAdd(ByVal Item As Object)
'UpdatebyExtendoffice20180418
Dim xMailItem As Outlook.MailItem
Dim xReplyMailItem As Outlook.MailItem
Dim xReplyHTMLBody As String
Dim xAppointments As Outlook.Items
Dim xFilter As String
Dim xRestrictAppointments As Outlook.Items
Dim xAppointment As Outlook.AppointmentItem
Dim xDateFormat As String
On Error Resume Next
If TypeOf Item Is MailItem Then
    Set xMailItem = Item
    Set xReplyMailItem = xMailItem.Reply
    xReplyHTMLBody = xReplyMailItem.HTMLBody
    Set xAppointments = Outlook.Application.Session.GetDefaultFolder(olFolderCalendar).Items
    xAppointments.Sort "[Start]"
    xAppointments.IncludeRecurrences = True
    xDateFormat = Format(Now, "ddddd h:nn AMPM")
    xFilter = "[Start]<= '" & xDateFormat & "' AND [End]>= '" & xDateFormat & "'"
    Set xRestrictAppointments = xAppointments.Restrict(xFilter)
    If TypeName(xRestrictAppointments) = "Nothing" Then Exit Sub
    For Each xAppointment In xRestrictAppointments
        If xAppointment.BusyStatus = olBusy Or olOutOfOffice Then
            xReplyMailItem.HTMLBody = "<HTML><BODY>I'm Sorry that I can't respond to you right now. I'll reply to you later.</HTML></BODY>" & _
                                      xReplyHTMLBody
            xReplyMailItem.Send
        End If
    Next
End If
End Sub

3. 保存此代码并重新启动 Outlook。从现在开始，如果在您的预约时间范围内收到邮件，将发送自动回复。

注意：

(1) 在代码中，您可以根据需要更改回复正文，例如将脚本中的 "I'm Sorry that I can't respond to you right now. I'll reply to you later." & _ 修改为您需要的内容。

(2) 此 VBA 宏可以自动回复默认数据文件收件箱中收到的邮件。