[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 3243
  • Last Modified:

Extract email address from body and auto-reply

I'm receiving numerous "registration" emails that I'd like to auto-reply to.

The incoming emails contain the same body...
User: Joe Bloggs
Email Address: jbloggs@wellknownemailprovider.com
Telephone: 07777123456

When the email hit's my inbox I would like to reply to the email address that's in the body

I'm familiar with VB but useless at it within Outlook
Could anyone lend a hand with the code needed to achieve this?
1
antonioking
Asked:
antonioking
  • 11
  • 6
  • 2
3 Solutions
 
Murali ReddyCommented:
Not possible from Outlook rules.

We can apply different actions based on the body/subject keywords, however there is no possibility to fetch the exact email address as the srting varies from mail to mail.
0
 
antoniokingAuthor Commented:
Hi Murali
Understand it's not possible with Outlook rules, which is why I'm asking for Visual Basic code to achieve this.
Regards
0
 
Murali ReddyCommented:
I'm not good at, wait someone else will post. All the best.
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
ltlbearand3Commented:
You will need to use VBA within Outlook to handle this request.  You will want to place this code in the Outlook Macros (ALT-F11 to access) under Microsoft Outlook Object >> ThisOutlookSession.  You will need to adjust your security to allow macros to run and there is some risk involved with that.  I suggest self-signing the Macro to allow some security to still be on - see http://office.microsoft.com/en-us/outlook-help/digitally-sign-a-macro-project-HA001231781.aspx or even better http://www.howto-outlook.com/howto/selfcert.htm on how to do this.

You will need to adjust the RegEx pattern to find the correct email domain.  At the end of the code you need to decide if you want to display the email or send it.  Let me know if you have questions.

' ExpertExchange Question ID 28492433
' http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_28492433.html
' Expert: ltlbearand3 [http://www.experts-exchange.com/M_2469312.html]
'

Private Sub Application_NewMail()
    Dim objInbox As Outlook.Folder
    Dim objNewMail As Outlook.MailItem
    Dim objRegEx As VBScript_RegExp_55.RegExp
    Dim colFoundWords As VBScript_RegExp_55.MatchCollection
    Dim objFoundWord As VBScript_RegExp_55.Match
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    
    ' Get Access to You Inbox
    Set objInbox = Outlook.Session.GetDefaultFolder(olFolderInbox)
    
    ' Look for the most recent Unread Item in your inbox
    Set objNewMail = objInbox.Items.GetLast
    
    ' Set up Regular Expressions to search for the email Address
    Set objRegEx = New VBScript_RegExp_55.RegExp
    
    Debug.Print objNewMail.Body
        
    ' Search for Matching Email Addresses
    With objRegEx
        .IgnoreCase = True
        ' Set Global to False to only find the first instance as there could be more than one if they sent the email
        ' and it turned it into a link
        .Global = False
        ' This pattern will look for you email address - see http://www.regular-expressions.info/email.html if you want to know more
	  ' ******  Update this with the correct email domain
        .Pattern = "\b[A-Z0-9._%+-]+@wellknownemailprovider\.com\b."
        ' Run the Search
        Set colFoundWords = .Execute(objNewMail.Body)
    End With
    
    ' Make sure we found something.  We will work from just the first found instance.
    ' There may be more than one
    If colFoundWords.Count > 0 Then
        ' Create the outgoing message.
        Set objOutlookMsg = Outlook.CreateItem(olMailItem)
    
        With objOutlookMsg
            ' Add the To recipient(s) to the message.
            Set objOutlookRecip = .Recipients.Add(colFoundWords.Item(0))
            objOutlookRecip.Type = olTo
    
           ' Set the Subject, Body, and Importance of the message.
           .Subject = "This is an Automated Email"
           .Body = "This is the body of the message." & vbCrLf & vbCrLf
    
           ' Resolve each Recipient's name.
           For Each objOutlookRecip In .Recipients
               objOutlookRecip.Resolve
           Next
           
	     ' ********** YOU NEED TO UPDATE THE CODE HERE TO MAKE A CHOICE ************
            ' Uncomment to just Show the Email
            '.Display
            ' Or
            ' this line to Send it
            ' .Send
        End With
    End If
    
    ' Clean up
    Set objInbox = Nothing
    Set objNewMail = Nothing
    Set objRegEx = Nothing
    Set colFoundWords = Nothing
    Set objFoundWord = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookRecip = Nothing
        
End Sub

Open in new window

0
 
antoniokingAuthor Commented:
Hi ltlbearand3
Thanks for taking the time to help me. I appreciate it.

The email address in the incoming emails body will be completely different each email.
e.g..

jbloggs@hotmail.com
jdoe@gmail.co.uk
msmith@email.com

The pattern is it will always appear after the word "Email address: "

Kind regards
0
 
ltlbearand3Commented:
Since the patterns on email addresses can be kind of squirrely sometimes, we need a way to make sure we found the right piece of data.  One idea is just to look for text that matches an appropriate email address pattern.  Will there be times where there will be more than on email address in the email?  If not, maybe we can just ignore the "email address" text and just search for an email address.  If not, will the words Email Address: and the following email always be on their own line?

I can make this work with RegEx, I just am trying to keep the RegEx pattern from getting even more complicated than it is.  We can move to using an instr command which is slower, but might be easier to read code.  How much text will be in these emails, will they be pretty simple or might they contain a lot of text?
0
 
ltlbearand3Commented:
By the way here is a an adjustment to the script that will look for a valid email address anywhere in the text of the email and use the first found valid email address.

' ExpertExchange Question ID 28492433
' http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_28492433.html
' Expert: ltlbearand3 [http://www.experts-exchange.com/M_2469312.html]
'

Private Sub Application_NewMail()
    Dim objInbox As Outlook.Folder
    Dim objNewMail As Outlook.MailItem
    Dim objRegEx As VBScript_RegExp_55.RegExp
    Dim colFoundWords As VBScript_RegExp_55.MatchCollection
    Dim objFoundWord As VBScript_RegExp_55.Match
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    
    ' Get Access to You Inbox
    Set objInbox = Outlook.Session.GetDefaultFolder(olFolderInbox)
    
    ' Look for the most recent Unread Item in your inbox
    Set objNewMail = objInbox.Items.GetLast
    
    ' Set up Regular Expressions to search for the email Address
    Set objRegEx = New VBScript_RegExp_55.RegExp
    
    Debug.Print objNewMail.Body
        
    ' Search for Matching Email Addresses
    With objRegEx
        .IgnoreCase = True
        ' Set Global to False to only find the first instance as there could be more than one if they sent the email
        ' and it turned it into a link
        .Global = False
        ' This pattern will look for you email address - see http://www.regular-expressions.info/email.html if you want to know more
	  ' ******  Update this with the correct email domain
        .Pattern = "\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"
        ' Run the Search
        Set colFoundWords = .Execute(objNewMail.Body)
    End With
    
    ' Make sure we found something.  We will work from just the first found instance.
    ' There may be more than one
    If colFoundWords.Count > 0 Then
        ' Create the outgoing message.
        Set objOutlookMsg = Outlook.CreateItem(olMailItem)
    
        With objOutlookMsg
            ' Add the To recipient(s) to the message.
            Set objOutlookRecip = .Recipients.Add(colFoundWords.Item(0))
            objOutlookRecip.Type = olTo
    
           ' Set the Subject, Body, and Importance of the message.
           .Subject = "This is an Automated Email"
           .Body = "This is the body of the message." & vbCrLf & vbCrLf
    
           ' Resolve each Recipient's name.
           For Each objOutlookRecip In .Recipients
               objOutlookRecip.Resolve
           Next
           
	     ' ********** YOU NEED TO UPDATE THE CODE HERE TO MAKE A CHOICE ************
            ' Uncomment to just Show the Email
            '.Display
            ' Or
            ' this line to Send it
            ' .Send
        End With
    End If
    
    ' Clean up
    Set objInbox = Nothing
    Set objNewMail = Nothing
    Set objRegEx = Nothing
    Set colFoundWords = Nothing
    Set objFoundWord = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookRecip = Nothing
        
End Sub

Open in new window

1
 
antoniokingAuthor Commented:
What references do I need?

Thanks!
0
 
antoniokingAuthor Commented:
The body of the email will always look like this...
From: portal@keyapps.co.uk [mailto:portal@keyapps.co.uk] 
Sent: 19 March 2014 13:12
To: IT
Subject: Registration for Company - Name

User: Test Test
Email Address: test@test190314.com
Telephone: 111

Open in new window


The email address I wan't to reply to is on the line starting "Email Address: "

Regards
0
 
antoniokingAuthor Commented:
I say always, but obviously the User,Email and Telephone details will be different each email
0
 
antoniokingAuthor Commented:
' ExpertExchange Question ID 28492433
' http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_28492433.html
' Expert: ltlbearand3 [http://www.experts-exchange.com/M_2469312.html]
'

Private Sub Application_NewMail()
    Dim objInbox As Outlook.Folder
    Dim objNewMail As Outlook.MailItem
    Dim objRegEx As VBScript_RegExp_55.RegExp
    Dim colFoundWords As VBScript_RegExp_55.MatchCollection
    Dim objFoundWord As VBScript_RegExp_55.Match
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    
    ' Get Access to You Inbox
    Set objInbox = Outlook.Session.GetDefaultFolder(olFolderInbox)
    
    ' Look for the most recent Unread Item in your inbox
    Set objNewMail = objInbox.Items.GetLast
    
    ' Set up Regular Expressions to search for the email Address
    Set objRegEx = New VBScript_RegExp_55.RegExp
    
    Debug.Print objNewMail.Body
        
    ' Search for Matching Email Addresses
    With objRegEx
        .IgnoreCase = True
        ' Set Global to False to only find the first instance as there could be more than one if they sent the email
        ' and it turned it into a link
        .Global = True
        ' This pattern will look for an email address - see http://www.regular-expressions.info/email.html if you want to know more
        .Pattern = "Email\sAddress:\s\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"
        ' Run the Search
        Set colFoundWords = .Execute(objNewMail.Body)
    End With
    
    ' Make sure we found something.  We will work from just the first found instance.
    ' There may be more than one
    If colFoundWords.Count > 0 Then
        ' Create the outgoing message.
        Set objOutlookMsg = Outlook.CreateItem(olMailItem)
    
        With objOutlookMsg
            ' Add the To recipient(s) to the message.
            Set objOutlookRecip = .Recipients.Add(Mid(colFoundWords.Item(0), 15))
            objOutlookRecip.Type = olTo
    
           ' Set the Subject, Body, and Importance of the message.
           .Subject = "This is an Automated Email"
           .Body = "This is the body of the message." & vbCrLf & vbCrLf
    
           ' Resolve each Recipient's name.
           For Each objOutlookRecip In .Recipients
               objOutlookRecip.Resolve
           Next
           
         ' ********** YOU NEED TO UPDATE THE CODE HERE TO MAKE A CHOICE ************
            ' Uncomment to just Show the Email
            .Display
            ' Or
            ' this line to Send it
            ' .Send
        End With
    End If
    
    ' Clean up
    Set objInbox = Nothing
    Set objNewMail = Nothing
    Set objRegEx = Nothing
    Set colFoundWords = Nothing
    Set objFoundWord = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookRecip = Nothing
        
End Sub

Open in new window

I modified the code so it picks up the "Email Address: " line!

Thanks for all your help
0
 
antoniokingAuthor Commented:
Could you help modify the code so it only runs for emails with a particular subject
"Registration for Company ..."
(... may differ)

Maybe use an Outlook rule to then run the macro instead of it running for every single incoming email?
0
 
ltlbearand3Commented:
Sorry, I have been a little busy this afternoon.  Obviously you figured out you that you need a reference to "Microsoft VBScript Regular Expressions 5.5"

Changing this code to only run through a rule is a great idea.  He is how to make that happen.

First take the code you have and change the first line of:
Private Sub Application_NewMail()

Open in new window


And change it to:
Sub CustomMailMessageRule(Item As Outlook.MailItem)

Open in new window

You can change CustomMailMessageRule to whatever you want to call it.

Then create your rule in outlook to filter the message.  In the "What do you want to do with this message?" section choose, run a script.  Click on the script link and then choose "CustomMailMessageRule".  That should do it.
0
 
antoniokingAuthor Commented:
I have setup 2 rules
One that runs your script when an email with the subject containing "Registration for Company" is received.
A second rule marks the email as read and moves it to a sub-folder called "Registrations"


Occasionally this error occurs
"Run-time error '13' Type Mismatch"
On line
Set objNewMail = objInbox.Items.GetLast


I think the error is because the item has been moved from the Inbox or maybe because it's no longer marked as read

However... the rule that runs the script is top priority in the Outlook rules list.
If the item is not marked as read will your script detect it again when another email arrives that prompts the script to run?
0
 
antoniokingAuthor Commented:
Actually, I've turned off the 2nd rule that moves the email and marks it as read.
The script still crashes at that line.
If I then manually run it using the Run Rules Now option, it runs fine.
0
 
ltlbearand3Commented:
Sorry.  With the way we changed things to use a rule, I should have changed the script to just use the item that triggered the rule instead of trying to find it.  There can be timing issues when using a rule to run the script.  Try this code instead:

' ExpertExchange Question ID 28492433
' http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_28492433.html
' Expert: ltlbearand3 [http://www.experts-exchange.com/M_2469312.html]
'
' -------------------------------------------------------------------------------
' MUST HAVE A REFERENCE TO:
'   Microsoft VBScript Regular Expressions 5.5
' -------------------------------------------------------------------------------

Sub CustomMailMessageRule(Item As Outlook.MailItem)
    Dim objRegEx As VBScript_RegExp_55.RegExp
    Dim colFoundWords As VBScript_RegExp_55.MatchCollection
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    
    ' Set up Regular Expressions to search for the email Address
    Set objRegEx = New VBScript_RegExp_55.RegExp
    
    ' Search for Matching Email Addresses
    With objRegEx
        .IgnoreCase = True
        ' Set Global to False to only find the first instance as there could be more than one if they sent the email
        ' and it turned it into a link
        .Global = True
        ' This pattern will look for an email address - see http://www.regular-expressions.info/email.html if you want to know more
        .Pattern = "Email\sAddress:\s\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b"
        ' Run the Search
        Set colFoundWords = .Execute(Item.Body)
    End With
    
    ' Make sure we found something.  We will work from just the first found instance.
    ' There may be more than one
    If colFoundWords.Count > 0 Then
        ' Create the outgoing message.
        Set objOutlookMsg = Outlook.CreateItem(olMailItem)
    
        With objOutlookMsg
            ' Add the To recipient(s) to the message.
            Set objOutlookRecip = .Recipients.Add(Mid(colFoundWords.Item(0), 15))
            objOutlookRecip.Type = olTo
    
           ' Set the Subject, Body, and Importance of the message.
           .Subject = "This is an Automated Email"
           .Body = "This is the body of the message." & vbCrLf & vbCrLf
    
           ' Resolve each Recipient's name.
           For Each objOutlookRecip In .Recipients
               objOutlookRecip.Resolve
           Next
           
         ' ********** YOU NEED TO UPDATE THE CODE HERE TO MAKE A CHOICE ************
            ' Uncomment to just Show the Email
            .Display
            ' Or
            ' this line to Send it
            ' .Send
        End With
    End If
    
    ' Clean up
    Set objRegEx = Nothing
    Set colFoundWords = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookRecip = Nothing
End Sub

Open in new window


Test with this change, but you should be able to turn your second rule back on with this code.
0
 
antoniokingAuthor Commented:
Thanks again! This script works perfect
0
 
antoniokingAuthor Commented:
Thanks for all your help!
0
 
ltlbearand3Commented:
Your welcome.  Glad it works for you.
0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

  • 11
  • 6
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now