Can I check if a recipient has an automatic reply before I send an email?

Question

I have a macro set up that will automatically send out emails to dozens of managers. Sometimes they\'re away and I have to check the away message and manually forward it to

Answer 1

The answer to the similar question you found (Remove recipients from Outlook email if automatic reply is activated) still stands. What were you having problem with?

The only additional possibility (and this is what Outlook uses when it displays an OOF banner for a recipient you are about to send to) is to use EWS and the GetMailTips operation (see https://msdn.microsoft.com/en-us/library/office/dd877060(v=exchg.150).aspx).

Answer 2

This is not a proper answer but an attempt to get you started.

Your code suggests your knowledge of Outlook VBA is limited. If this is true, I doubt that any of the approaches in “a similar question” will be appropriate. Are you familiar with Visual Studio, C++, Delphi or Redemption? Even if you managed to access PR_OOF_STATE, you would not have the alternative email address.

I would start by attempting to extract the email address from the out-of-office reply. Looking for “@” and extracting the text back to and forward to the next space might be enough.

Copy the code below to an Outlook VBA module. Select one of the out-of-office replies and run macro DemoExplorer. The objective of this macro is to show you what the text and Html bodies of the email look like. Try this macro on other replies. Are the bodies consistent? Can you see how to extract the alternative email address?

Public Sub DemoExplorer()

  Dim Exp As Outlook.Explorer
  Dim ItemCrnt As MailItem
  Dim NumSelected As Long

  Set Exp = Outlook.Application.ActiveExplorer

  NumSelected = Exp.Selection.Count

  If NumSelected = 0 Then
    Debug.Print "No emails selected"
  Else
    For Each ItemCrnt In Exp.Selection
      With ItemCrnt
        Debug.Print "From " & .SenderName & " Subject " & .Subject
        Debug.Print "Text " & Replace(Replace(Replace(.Body, vbLf, "{lf}"), vbCr, "{cr}"), vbTab, "{tb}")
        Debug.Print "Html " & Replace(Replace(Replace(.HTMLBody, vbLf, "{lf}"), vbCr, "{cr}"), vbTab, "{tb}")
      End With
    Next
  End If

End Sub