Outlook：返信がない場合にメールを自動再送信する方法

同僚や協力パートナー、または他の相手にメールを送信する際、緊急で返信が必要な場合は、あらかじめ指定した時刻までに返信がない場合に自動でメールを再送信する設定が可能です。

リマインダーと VBA を使用して、返信がない場合に自動再送信を設定する

---

リマインダーと VBA を使用して、返信がない場合に自動再送信を設定する

パート 1：指定した時刻にリマインドするためのリマインダーを設定する

1。返信がない場合に再送信したいメール（「送信済みアイテム」フォルダー内）を右クリックし、表示されるコンテキストメニューから［フォローアップ］→［リマインダーの追加］をクリックします。

2。「カスタム」ダイアログボックスが表示されたら、「リマインダー」チェックボックスがオンになっていることを確認し、その下のドロップダウンから返信を希望する日時を選択してください。日時は直接ボックス内に入力することも可能です。「OK」をクリックします。

パート 2：指定した時刻までに返信がない場合にメールを再送信する VBA を挿入する

3。「Alt」＋「F11」キーを押して、「Microsoft Visual Basic for Applications」ウィンドウを開きましょう。

4。「プロジェクト – Project1」ペインで「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 のオプション」ウィンドウで、左側のペインから「トラストセンター」を選択し、「トラストセンターの設定」をクリックして「トラストセンター」ウィンドウを開きます。次に、「マクロの設定」をクリックし、右側のセクションで「すべてのマクロを有効にする（推奨されません。危険なコードが実行される可能性があります）」が選択されていることを確認してください。「OK」をクリックして「トラストセンター」ウィンドウを閉じ、さらに「OK」をクリックして「Outlook のオプション」ウィンドウを閉じます。

6。これで、リマインダーを設定した送信済みメールに指定時刻までに返信が届かない場合、メールを再送信して通知するかどうかを尋ねるダイアログボックスが表示されます。

7。「はい」をクリックすると、以前のメールが添付されたメッセージウィンドウが開きます。本文を再編集して「送信」をクリックすれば、メールを再送信できます。

8。「いいえ」をクリックすると、リマインダーが削除されます。

注：指定時刻より前にメールに返信があると、VBA によってリマインダーが自動的に削除されます。