Outlook：如果没有回复，如何自动重新发送电子邮件

当您向您的同事或合作伙伴或某人发送电子邮件并紧急需要回复时，如果在指定时间之前没有回复，您可以设置自动重新发送电子邮件设置。

如果没有响应，使用提醒和 VBA 设置自动重新发送

如果没有响应，使用提醒和 VBA 设置自动重新发送

第 1 部分：设置提醒以在指定时间提醒

1. 如果没有回复，右键单击要重新发送的电子邮件（来自已发送邮件文件夹），在弹出的上下文菜单中，单击 课后跟进 > 添加提醒.

2.在弹出 定制 对话框中，保留 提醒 勾选复选框，然后在下面的下拉框中，选择您希望回复到达之前的日期和时间，您也可以直接在框中输入日期和时间。 点击 OK.

第 2 部分：如果在指定时间内没有回复，则插入 VBA 以重新发送电子邮件

3。 按 其他 + F11 启用 Microsoft Visual Basic应用程序 窗口。

4.双击 本次展望会议 在 项目——项目1 窗格以创建空白脚本，并将以下 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 recieved 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.保存代码，然后回到主界面，点击 文件 > 附加选项 并且在e Outlook 选项 窗口中，单击 信任中心 在左窗格中，然后单击 信任中心设置 使之成为可能 信任中心 窗口。 点击 宏设置 并确保 启用所有宏（不推荐;有潜在危险的代码可以运行） 在右侧部分中选择了选项。 点击 OK > OK.

6. 现在如果设置了提醒的已发送邮件在指定时间到达时没有收到回复，会弹出对话框提醒您是否重新发送邮件进行通知。

7。 点击 有，会弹出一个消息窗口并附上上一封邮件，您可以重新编辑正文并单击 发送 重新发送电子邮件..

8。 点击 没有，提醒将被删除。

备注： 如果邮件在指定时间之前已经回复，VBA 将删除该提醒。

Kutools for Outlook-为Outlook带来100个高级功能，并使工作更加轻松！

• 自动CC / BCC 根据规则发送电子邮件； 自动转发 自定义多封电子邮件； 自动回复 没有交换服务器，还有更多自动功能...
• BCC警告 -当您尝试全部答复时显示消息 如果您的邮件地址在“密件抄送”列表中; 缺少附件时提醒，还有更多提醒功能...
• 在邮件对话中回复（全部）带有所有附件; 回复许多电子邮件 很快; 自动添加问候语 回复时将日期添加到主题中...
• 附件工具：管理所有邮件中的所有附件， 自动分离, 全部压缩，全部重命名，全部保存...快速报告， 计算选定的邮件...
• 强大的垃圾邮件 习俗 删除重复的邮件和联系人... 使您能够在Outlook中做得更聪明，更快和更好。

阅读更多 现在下载...