如何在 Outlook 中忙碌時自動回覆收到的郵件？

Author: Sun Last Modified: 2025-05-12

有時候，當您一段時間內忙碌時，您希望能夠自動回覆收到的郵件。但 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) 在程式碼中，您可以根據需要更改回覆正文，例如將這段文字改為「很抱歉，我無法立即回覆您。我稍後會回覆您。」 & _

(2) 此 VBA 宏可自動回覆預設數據文件收件匣中收到的郵件。