Outlook:如何在沒有答覆時自動重新發送郵件
當您向同事、合作夥伴或其他人發送郵件並且急需得到答覆時,您可以設置一個自動重新發送郵件的設定,以防在指定時間之前未收到答覆。
使用提醒和VBA來設置無答覆時自動重新發送
第一部分:設置提醒以在指定時間提醒
1. 右鍵單擊您希望在沒有答覆時重新發送的郵件(從已傳送郵件資料夾中),在彈出的上下文選單中,點擊「需後續工作」>「新增提醒」。

2. 在彈出的「自定義」對話框中,保持「提醒」複選框被勾選,然後在下方的下拉框中選擇您希望收到答覆的日期和時間,您也可以直接在框中輸入日期和時間。點擊「確定」。


第二部分:插入VBA程式碼以在指定時間內無答覆時重新發送郵件
3. 按下「Alt」+「F11」鍵以啟用「Microsoft Visual Basic for Applications」窗口。
4. 在「專案 – 專案1」窗格中雙擊「ThisOutlookSession」以創建一個空白腳本,並將以下VBA代碼複製並粘貼到空白腳本中。
VBA:如果沒有答覆則重新發送郵件
Public WithEvents GInboxItems As Outlook.Items
'UpdatebyExtendoffice20220413
Private Sub Application_Startup()
Dim xInboxFld As Folder
Set xInboxFld = Application.Session.GetDefaultFolder(olFolderInbox)
Set GInboxItems = xInboxFld.Items
End Sub
'Judge
Private Sub GInboxItems_ItemAdd(ByVal Item As Object)
Dim xSentItems As Outlook.Items
Dim xMail As MailItem
Dim i As Long
Dim xSubject As String
Dim xItemSubject As String
Dim xSendTime As String
On Error Resume Next
Set xSentItems = Application.Session.GetDefaultFolder(olFolderSentMail).Items
If Item.Class <> olMail Then Exit Sub
For i = xSentItems.Count To 1 Step -1
If xSentItems.Item(i).Class = olMail Then
Set xMail = xSentItems.Item(i)
xSubject = LCase(xMail.Subject)
xSendTime = xMail.SentOn
xItemSubject = LCase(Item.Subject)
If (xItemSubject = "re: " & xSubject) Or (InStr(xItemSubject, xSubject) > 0) Then
If Item.SentOn > xSendTime Then
With xMail
.ClearTaskFlag
.ReminderSet = False
.Save
End With
End If
End If
End If
Next i
End Sub
'Reminder
Private Sub Application_Reminder(ByVal Item As Object)
Dim xPrompt As String
Dim xResponse As Integer
Dim xFollowUpMail As Outlook.MailItem
Dim xRcp As Recipient
On Error Resume Next
'Resend
If (Item.Class <> olMail) Then Exit Sub
xPrompt = "You haven't yet received the reply of " & Chr(34) & Item.Subject & Chr(34) & " within your expected time. Do you want to send a follow-up notification email?"
xResponse = MsgBox(xPrompt, vbYesNo + vbQuestion, "Kutools for Outlook")
If xResponse = vbNo Then Exit Sub
Set xFollowUpMail = Application.CreateItem(olMailItem)
With xFollowUpMail
For Each xRcp In Item.Recipients
.Recipients.Add (xRcp.Address)
Next
.Recipients.ResolveAll
.Subject = "Follow Up: " & Chr(34) & Item.Subject & Chr(34)
.Body = "Please respond to my email " & Chr(34) & Item.Subject & Chr(34) & " as soon as possible"
.Attachments.Add Item
.Display
End With
End Sub
5. 保存代碼,然後返回主界面,點擊「文件」>「選項」,在「Outlook 選項」窗口中,點擊左側窗格中的「信任中心」,然後點擊「信任中心設置」以啟用「信任中心」窗口。點擊「宏設置」,並確保右側部分中選擇了「啟用所有宏(不推薦;可能執行危險代碼)」選項。點擊「確定」>「確定」。


6. 現在,如果設置了提醒的已發送郵件在指定時間到達時仍未收到答覆,將會彈出一個對話框提醒您是否要重新發送郵件以進行通知。

7. 點擊「是」,將彈出一個消息窗口並附上之前的郵件,您可以重新編輯正文並點擊「發送」以重新發送郵件。

8. 點擊「否」,提醒將被刪除。

注意:如果郵件在指定時間之前已被回覆,VBA將自動移除提醒。
最佳辦公室生產力工具
最新消息:Kutools for Outlook推出免費版本!
體驗全新的Kutools for Outlook免費版本,擁有70多項令人驚嘆的功能,永久使用!立即點擊下載!
🤖 Kutools AI :使用先進的AI技術輕鬆處理郵件,包括答覆、摘要、優化、擴展、翻譯和撰寫郵件。
📧 郵件自動化:自動回覆(適用於POP和IMAP) / 計劃發送郵件 / 發送郵件時按規則自動抄送密送 / 自動轉發(高級規則) / 自動新增問候語 / 自動將多收件人郵件拆分為個別郵件...
📨 郵件管理:撤回郵件 / 按主題和其他方式阻止詐騙郵件 / 刪除重複郵件 / 高級搜索 / 整合文件夾...
📁 附件專業版:批量保存 / 批量拆離 / 批量壓縮 / 自動保存 / 自動拆離 / 自動壓縮...
🌟 介面魔法:😊更多漂亮和酷炫的表情符号 / 當重要郵件到來時提醒您 / 最小化Outlook而不是關閉...
👍 一鍵奇蹟:帶附件全部答復 / 防止網絡釣魚郵件 / 🕘顯示發件人的時區...
👩🏼🤝👩🏻 聯絡人和日曆:從選中郵件批量新增聯絡人 / 將聯絡人組拆分為個別組 / 移除生日提醒...
立即單擊解鎖Kutools for Outlook。不要等待,立即下載並提升您的效率!

