none
Need Help with VBA Code Auto-Generate Email Reply Based on Subject and Send To Email Address in Body RRS feed

  • Question

  • I have looked all over Google and forums and many other places to find the answer to my question, but I can only find pieces. This is what I need. 

    We are receiving lead emails with the Subject: "Tax Case Lead #***-***-****"

    Every email that comes in has a different lead number, but "Tax Case Lead" is always there, so that would be my trigger.

    The emails are received from a generic email address and this is the body of the email (redacted, of course):

    Dear *** ,

    DO NOT REPLY TO THIS EMAIL. Contact this person at johndoe@domain.com or call  (888) 888-8888

    Case Lead ID: #***-***-****

    Time Entered: Mon, July 28th, 5:37am (Pacific time)
    Website Entered On: xyz.com

    Practice Area: Tax
    Location: Anywhere, USA

    Contact Information
    First Name: John 
    Last Name: Doe 
    Email: johndoe@domain.com
    Phone Number: (888) 888-8888

    Request Details

    1. Total Tax Debt: $10,000 - $25,000
    2. Federal or State: Federal
    3. Tax Problems: Other

    Description:

    Tax Debt

    What I would like is the complete VB code to accomplish the following:

    1. When email is received with Subject including "Tax Case Lead", a new email is generated

    2. The Recipient of the email is the email address listed in the body of the email.

    3. The Subject of the email is: "Response to Your Request for Tax Help"

    4. The Body of the email is: "We have received your email and would like to advise you of the options available in dealing with your IRS tax matters..."

    5. Send the email.

    Like I said, I've been trying to put it together in bits and pieces and it's not working. Any help is greatly appreciated. Thanks.

    Nina

    Monday, July 28, 2014 7:34 PM

Answers

  • This is fairly straightforward to achieve.

    Create a rule that detects the relevant incoming messages and runs the script 'AutoReply' . I have included below it a macro to enable you to test it on an existing message.

    You might want to include some error checking for e.g. missing names or invalid e-mail addresses, but otherwise it should work.

    Sub AutoReply(Item As Outlook.MailItem)
    Dim i As Long, j As Long
    Dim vText As Variant
    Dim vAddr As Variant
    Dim vItem As Variant
    Dim sAddr As String
    Dim sName As String
    Dim olInsp As Outlook.Inspector
    Dim wdDoc As Object
    Dim oRng As Object
    Dim olOutMail As Outlook.MailItem
        With Item
            'Get the text of the message
            'and split it by paragraph
            vText = Split(Item.Body, Chr(13))
            'Examine each paragraph
            For i = 1 To UBound(vText)
                If InStr(1, vText(i), "First Name:") > 0 Then
                    vItem = Split(vText(i), Chr(58))
                    sName = Trim(vItem(1))
                End If
                If InStr(1, vText(i), "Email:") > 0 Then
                    vItem = Split(vText(i), Chr(58))
                    sAddr = ""
                    For j = 1 To UBound(vItem)
                        sAddr = sAddr & vItem(j)
                    Next j
                    If InStr(1, UCase(sAddr), "HYPERLINK") > 0 Then
                        vAddr = Split(sAddr, Chr(34))
                        sAddr = vAddr(UBound(vAddr))
                    End If
                End If
            Next i
            Set olOutMail = Application.CreateItem(0)
            With olOutMail
                .BodyFormat = olFormatHTML
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor 'Edit the message body
                Set oRng = wdDoc.Range(Start:=0, End:=0) 'Set a range to the start of the body (thus preserving the signature)
                .To = sAddr
                .Subject = "Response to Your Request for Tax Help"
                'personalise the reply message body
                oRng.Text = "Dear " & sName & vbCr & vbCr & "We have received your email and would like to advise you of the options available in dealing with your IRS tax matters..."
                .Display 'This line is required
                '.Send       'add .Send after testing if you are happy not to check the message before sending.
            End With
            Set olOutMail = Nothing
        End With
    End Sub

    Sub TestReply()
    Dim olmsg As MailItem
        On Error Resume Next
        Set olmsg = ActiveExplorer.Selection.Item(1)
        AutoReply olmsg
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com


    • Edited by Graham MayorMVP Wednesday, July 30, 2014 1:27 PM
    • Marked as answer by Bosox1277 Wednesday, July 30, 2014 5:22 PM
    Wednesday, July 30, 2014 1:23 PM

All replies

  • You could start with showing what you currently have in place. Maybe we could help you put the pieces together.

    Happy to help ! When you see answers and helpful posts, please click Vote As Helpful, Propose As Answer, and/or Mark As Answered

    Wednesday, July 30, 2014 12:34 PM
  • This is fairly straightforward to achieve.

    Create a rule that detects the relevant incoming messages and runs the script 'AutoReply' . I have included below it a macro to enable you to test it on an existing message.

    You might want to include some error checking for e.g. missing names or invalid e-mail addresses, but otherwise it should work.

    Sub AutoReply(Item As Outlook.MailItem)
    Dim i As Long, j As Long
    Dim vText As Variant
    Dim vAddr As Variant
    Dim vItem As Variant
    Dim sAddr As String
    Dim sName As String
    Dim olInsp As Outlook.Inspector
    Dim wdDoc As Object
    Dim oRng As Object
    Dim olOutMail As Outlook.MailItem
        With Item
            'Get the text of the message
            'and split it by paragraph
            vText = Split(Item.Body, Chr(13))
            'Examine each paragraph
            For i = 1 To UBound(vText)
                If InStr(1, vText(i), "First Name:") > 0 Then
                    vItem = Split(vText(i), Chr(58))
                    sName = Trim(vItem(1))
                End If
                If InStr(1, vText(i), "Email:") > 0 Then
                    vItem = Split(vText(i), Chr(58))
                    sAddr = ""
                    For j = 1 To UBound(vItem)
                        sAddr = sAddr & vItem(j)
                    Next j
                    If InStr(1, UCase(sAddr), "HYPERLINK") > 0 Then
                        vAddr = Split(sAddr, Chr(34))
                        sAddr = vAddr(UBound(vAddr))
                    End If
                End If
            Next i
            Set olOutMail = Application.CreateItem(0)
            With olOutMail
                .BodyFormat = olFormatHTML
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor 'Edit the message body
                Set oRng = wdDoc.Range(Start:=0, End:=0) 'Set a range to the start of the body (thus preserving the signature)
                .To = sAddr
                .Subject = "Response to Your Request for Tax Help"
                'personalise the reply message body
                oRng.Text = "Dear " & sName & vbCr & vbCr & "We have received your email and would like to advise you of the options available in dealing with your IRS tax matters..."
                .Display 'This line is required
                '.Send       'add .Send after testing if you are happy not to check the message before sending.
            End With
            Set olOutMail = Nothing
        End With
    End Sub

    Sub TestReply()
    Dim olmsg As MailItem
        On Error Resume Next
        Set olmsg = ActiveExplorer.Selection.Item(1)
        AutoReply olmsg
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com


    • Edited by Graham MayorMVP Wednesday, July 30, 2014 1:27 PM
    • Marked as answer by Bosox1277 Wednesday, July 30, 2014 5:22 PM
    Wednesday, July 30, 2014 1:23 PM
  • Thank you Graham for the code. I put the code in and it does display an email, but it does not pull the email address from the body of the email and make it the "TO" address. How can I do that?
    Wednesday, July 30, 2014 4:42 PM
  • Nevermind, I got it to work, it was my error that made it not work. Thank you so much. 
    Wednesday, July 30, 2014 5:22 PM