Outlook AutoReplies: One Script, Many Responses

I found some really old “cold call” messages in my Inbox from users asking for help that I missed. This is one such message, from Amit, a 7th grader. I feel bad that I missed his message because it's a fun and useful project.

I have a created an extra-curricular activity in Math. I send a problem to my friends in email and when they reply, I have two rules in outlook PROBLEM1_CORRECT followed by PROBLEM1_WRONG.

If the reply email is correct, I use a template and automatic reply goes to sender that they are correct and if they are wrong, I send an automatic reply to them that they are wrong.

I plan to do this everyday.

The problem is the rule only runs one time. So let's say after day2 I have following rules in my outlook defined PROBLEM1_CORRECT, PROBLEM1_WRONG, PROBLEM2_CORRECT, PROBLEM2_WRONG.

Not everyone replies on same day and when people choose to reply to all problems in a single sitting after day 2, the feedback for only one response goes to them not to the other.

I understand that MS Outlook sends email only once to the sender per day. Is there a way I can have the rule run and reply email no matter how many times a responder sends?

The bad news, no you can’t change the automatic reply behavior. It works like this to prevent a mail storm, where two Outlook autoreply to autoreplies that are autoreplies to autoreplies. This happened to me back in the dialup days, and by the time I stopped it the two clients were sending 1 MB messages back and forth.

You have two better options though. You can either use a Run a Script rule to filter the mail, so that only those messages that are responding to your quiz are processed by the script, or you can use an ItemAdd macro to look for email that meets a specific condition, in my example, the subject contains the word "week". (You'll probably want to use a more unique condition though.)

Within the macro, you could use a Select Case statement with the correct answers in the first Case. If the answer doesn’t match, the second Case applies, which sends the Wrong Answer template. The only problem? It’s easy to cheat, as replying with the same answer every time generates a “Correct” template.

To get past this problem, I'm using an array. The macro looks for a match in the first array and finds the answer in the second array.

For Amit's scenario, my macro assumes the answer is in the subject in this format: Week 1 answer. My macro checks the subject for the week number, finds the matching answer then looks for the answer in the subject.

Can you cheat? Not really, but it will match partial words, so you may want to use leading and following spaces. In my example, 450 is a correct response for Week 1 and owashingtonirving is correct for Week 2. When I use " 45 ", " Washington ", then it gets it right.

To avoid sending autoreplies to follow-up discussions, you'll want to look for additional words in the subject.

The macros below use two templates (as Amit asked), but you can use a standard reply by changing the code a little:

' Do something with the answer 
    Set oRespond = Item.Reply 
    If InStr(LCase(Item.Subject), LCase(strAnswer)) Then 

    ' Add a word or code to the subject so you filter out future replies 
     oRespond.Subject = "Correct " & item.subject 
     Else 
     oRespond.Subject = "Wrong!!!! " & item.subject  

    End If 

    With oRespond 
     .Recipients.Add Item.SenderEmailAddress 
     .HTMLBody = " The correct answer was " & strAnswer & vbCrLf & .HTMLBody 
    ' use .display for testing, .send after it is working as desired 
     '.Display 
     .Send 
    End With 

Run a Script Rule

Create a rule containing the Conditions necessary to identify an answer message. Choose Run a Script as the Action and select this script.

Sub AutoReplyAnswer(Item As Outlook.MailItem) 

    Dim oRespond As Outlook.MailItem 
    Dim strAnswer As String 
    Dim arrQuestion As Variant 
    Dim arrAnswer As Variant 
    Dim i As Long 

    ' Set up the arrays 

    arrQuestion = Array("Week 1 ", "Week 2 ", "Week 3 ", "Week 4 ", "Week 5", "Week 6", "Week 7", "Week 8", "Week 9", "Week 10") 

    arrAnswer = Array("45", "Washington", "Sochi", "1776", "Green", "14", "Richard", "Whale", "18", "Easter") 

      
    ' Go through the array and look for a match, assign it to a string 

    For i = LBound(arrQuestion) To UBound(arrQuestion) 
     If InStr(Item.Subject, arrQuestion(i)) Then strAnswer = arrAnswer(i) 
    Next i 
    Debug.Print strAnswer 

    ' Do something with the answer 
    If InStr(LCase(Item.Subject), LCase(strAnswer)) Then 
     Set oRespond = Application.CreateItemFromTemplate("C:\path\to\correct.oft") 
     Else 
     Set oRespond = Application.CreateItemFromTemplate("C:\path\to\wrong.oft") 
    End If 

    With oRespond 
     .Recipients.Add Item.SenderEmailAddress 
     .Subject = oRespond.Subject & " "& Item.Subject 
     .HTMLBody = " The correct answer was "& strAnswer & vbCrLf& Item.HTMLBody 
    ' use .display for testing, .send after it is working as desired 
     '.Display 
     .Send 
    End With 
Set oRespond = Nothing
End Sub

See Outlook's Rules and Alerts: Run a Script for help using a Run a Script rule and Run a script rule: Autoreply using a template for a simple template script.

ItemAdd Macro

This macro looks for news messages in the Inbox and checks the subject for the word Week. (You'll want to use a more unique keyword.) If Week is found in the subject, it checks to see if Correct or Wrong are also present, so the macro doesn't autoreply if someone replies to the answer message.

You could use a regular rule to move the messages to a folder then watch that folder for new messages, checking to see if they were already replied to.

Option Explicit
Private WithEvents Items As Outlook.Items
 
Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Set Ns = Application.GetNamespace("MAPI")
  Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
End Sub
 
Private Sub Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem And InStr(1, Item.Subject, "Week") Then
  GoTo SendReply
  Else
  Exit Sub
  End If

SendReply:
' don't send autoreply if one was already sent
  If InStr(1, Item.Subject, "Correct") Or InStr(1, Item.Subject, "Wrong") Then
  Exit Sub ' to avoid sending an autoreply to a follow-up message
  End If
Dim oRespond As Outlook.MailItem

Dim strAnswer As String
Dim arrQuestion As Variant
Dim arrAnswer As Variant
Dim i As Long
 
' Set up the array
arrQuestion = Array("Week 1 ", "Week 2 ", "Week 3 ", "Week 4 ", "Week 5", "Week 6", "Week 7", "Week 8", "Week 9", "Week 10")
arrAnswer = Array("45", "Washington", "Sochi", "1776", "Green", "14", "Richard", "Whale", "18", "Easter")

 
' Go through the array and look for a match, then do something
For i = LBound(arrQuestion) To UBound(arrQuestion)
    If InStr(Item.Subject, arrQuestion(i)) Then strAnswer = arrAnswer(i)
Next i

Debug.Print strAnswer

If InStr(LCase(Item.Subject), LCase(strAnswer)) Then
    Set oRespond = Application.CreateItemFromTemplate("C:\path\to\correct.oft")
       Else
    Set oRespond = Application.CreateItemFromTemplate("C:\path\to\wrong.oft")
End If

With oRespond
    .Recipients.Add Item.SenderEmailAddress
    .Subject = oRespond.Subject & " " & Item.Subject
    .HTMLBody = " The correct answer was " & strAnswer & vbCrLf & Item.HTMLBody
' use .display for testing, .send after it is working as desired
    '.Display
    .Send
End With

Set oRespond = Nothing
End Sub