Script to use in a rule when a message arrives to send to email in the message

Outlook version
Outlook 2010 32 bit
Email Account
POP3
#1
Hi,

What I'm wanting the script to do is this: extract the email address from an email, which is listed after "Email Address:" in the email, create a new message in which the recipient is that extracted email address with a new subject and the body of the email to be from an oft, then sent.

So, I need a little help. I have formulated a script with the information from other places on the forum, part of it worked one time, I made an adjustment, then the script doesn't seem to work at all, or do anything, but there are no errors that it brings up. This is what I have:

PHP:
Sub First(Item As Outlook.MailItem)
   Dim oItem As Outlook.MailItem
   Dim Reg1 As RegExp
   Dim Reg2 As RegExp
   Dim M1 As MatchCollection
   Dim M As Match
   Dim EntryID As New Collection
   Dim strID As String
   Set Reg1 = New RegExp
   Set Reg2 = New RegExp
 
   strID = Item.EntryID
   Set oItem = Application.Session.GetItemFromID(strID)

  With Reg1
       .Pattern = "(Email Address:\s*(\d*)\s*)"
       .Global = True
   End With
 
   If Reg1.test(oItem.Body) Then
       Set M1 = Reg1.Execute(oItem.Body)
       For Each M In M1
         strCode = M.SubMatches(1)
       Next
   End If
 
   With Reg2
     
       .Pattern = "([a-z0-9.]*)@([a-z0-9.]*)"
       .Global = True
   End With
   If Reg2.test(Item.Body) Then
       Set M1 = Reg2.Execute(Item.Body)
       For Each M In M1
         strAlias = M.SubMatches(1)
       Next
   End If
 
  
 
'------------ 
 'Item.Subject = "New Subject Title" & strCode
'Item.Save 
 
Set oItem = Nothing 
 
Dim objMsg As MailItem 
 
Set objMsg = Application.CreateItemFromTemplate("C:\Documents and Settings\Name\My Documents\First Email.oft") 
 
objMsg.Recipients.Add strAlias & "[a-z0-9.]*)@([a-z0-9.]*)" 
 
objMsg.Subject = "New Subject Title" & strCode 
 
objMsg.Display '.Send 
 
Set objMsg = Nothing 
 
End Sub
Any and all help would be greatly appreciated. I've dabbled in writing scripts before, but I'm by no means proficient in them. They are great when they work!

Thanks!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#2
Re: Script to use in a rule when a message arrives to send to email in the mes

Does the code sorta/mostly work? Especially the first part? (i don't have messages to test it and don't have time to create some right now).

Add a

msgbox strAlias

after the 'end if' to see if its picking up the address.

This should be just the string containing the address -

objMsg.Recipients.Add strAlias

If you don't want to use a template, use

set objmsg = Application.CreateItem(olMailItem)
 
Outlook version
Outlook 2010 32 bit
Email Account
POP3
#3
Re: Script to use in a rule when a message arrives to send to email in the mes

Well, let's say it this way, when I run the rule with the script, I don't get any errors, but I also don't show that I've sent an email (or have one display if coded).

I've attempted to clean up the code, but that doesn't seem to do anything more (or worse):
PHP:
Sub Message1(Item As Outlook.MailItem)
  Dim oItem As Outlook.MailItem    Dim Reg1 As RegExp    Dim Reg2 As RegExp    Dim M1 As MatchCollection    Dim M As Match    Dim EntryID As New Collection    Dim strID As String            Set olMail = Application.ActiveExplorer().Selection(1)   ' Debug.Print olMail.Body     Set Reg1 = New RegExp    Set Reg2 = New RegExp        strID = Item.EntryID    Set oItem = Application.Session.GetItemFromID(strID)         ' \s* = invisible spaces    ' \d* = match digits    ' \w* = match alphanumeric         With Reg1        .Pattern = "(Email Address:\s*[:]\s*(\d*)\s*)"        .Global = True    End With        If Reg1.test(oItem.Body) Then        Set M1 = Reg1.Execute(oItem.Body)        For Each M In M1          strCode = M.SubMatches(1)        Next    End If        With Reg2                .Pattern = "([a-z0-9.]*)@([a-z0-9.]*)"        .Global = True    End With
   If Reg2.test(Item.Body) Then        Set M1 = Reg2.Execute(Item.Body)        For Each M In M1          strAlias = M.SubMatches(1)        Next    End If 
 
MsgBox strAlias        Dim objMsg As MailItemSet objMsg = Application.CreateItemFromTemplate("C:\Documents and Settings\Elizabeth  Shewmaker\My Documents\Frist Email.oft") objMsg.Recipients.Add strAlias & "[a-z0-9.]*)@([a-z0-9.]*)"objMsg.Display 
 
End Sub
Would it be possible also that I have the script in the wrong thing?

screenshot.jpg
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#4
Re: Script to use in a rule when a message arrives to send to email in the mes

This works for me - it's a run a rule script and works in either a module or thisoutlooksession. I added the msgboxes so you can see the result of each regex.

Because its a run a script rule and the mailitem is declared in the sub, we don't need the message id or to switch it to oitem.

Code:
Sub First(Item As Outlook.MailItem)
   Dim Reg1 As RegExp
   Dim Reg2 As RegExp
   Dim M1 As MatchCollection
   Dim M As Match
   Set Reg1 = New RegExp
   Set Reg2 = New RegExp
    
  With Reg1
       .Pattern = "(Email Address:\s*(\d*)\s*)"
       .Global = True
   End With
 
   If Reg1.test(Item.Body) Then
       Set M1 = Reg1.Execute(Item.Body)
       For Each M In M1
         strcode = M.SubMatches(1)
         MsgBox "reg1: " & strcode
       Next
   End If
 
   With Reg2
     
       .Pattern = "([a-z0-9.]*)@([a-z0-9.]*)"
       .Global = True
   End With
   If Reg2.test(Item.Body) Then
       Set M1 = Reg2.Execute(Item.Body)
       For Each M In M1
         strAlias = M
         MsgBox "reg2: " & strAlias
       Next
   End If 
 
Dim objMsg As MailItem 
 
Set objMsg = Application.CreateItem(olMailItem) 
 
objMsg.Recipients.Add strAlias 
 
objMsg.Subject = "New Subject Title" & strcode 
 
objMsg.Display '.Send 
 
Set objMsg = Nothing 
 
End Sub
 
Outlook version
Outlook 2010 32 bit
Email Account
POP3
#5
Re: Script to use in a rule when a message arrives to send to email in the mes

It pulls the e-mail address, however a new e-mail is never created.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#6
Re: Script to use in a rule when a message arrives to send to email in the mes

My sample too? I replaced the call to a template with a blank message so we wouldn't have to worry about template problems until after we knew it worked.

It could mean the code is failing, but if you see the msgboxes, it gets all the data you need creating the message is simple. So simple, Outlook can't screw it up. :)
 

Ksd61

New Member
Outlook version
Outlook 2007
Email Account
POP3
#7
Diane -
I just joined so I could thank you for your helpful information. I've done a lot of VBA programming with excel, but never with outlook, and the info from these posts from last year helped me do exactly what I needed. Thank you!
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#8
Hi Diane

Just joined the forum to say thank you for an excellent and informative post that helped me tweak as well as shorten my code, so big thanks once again.

I will greatly appreciate if you could advise how can I replace text in template body e.g. Find "Customer" in "Dear Customer" and replace with the string stored in "strcode" and leaving rest of the text as it is.

I tried adding objMsg.Body = Dear & strcode in above code, it does work but rest of the text in template body disappears.

Thank you & best regards
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#9
This : objMsg.Body = Dear & strcode replaces the message body. Try objMsg.Body = Dear & strcode & vbcrlf & objmsg.body

If there is only one instance of Customer used, you can replace it using Replace() - Replace(objmsg.body. "Customer", strcode) - or use Replace(objmsg.body. "Dear Customer", "Dear " strcode).
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#11
Hi again Diane

Thank you for your great help the other day.
I'm now stuck again, I'm trying to fetch email address from incoming message formatted as below:

Email: abcdefg.2015@abcdemail.com

I've tried .Pattern = "([a-z0-9.]*)@([a-z0-9.]*)" which works absolutely fine but there're other email addresses before and after Email: as well that I don't need, I only need email address that follows Email: then I tried .Pattern = "(Email[:]([a-z0-9.]*)@([a-z0-9.]*))" but the code fails to run. As there are some spaces after Email: I think there might be a line break as well that causing code to fail, I will heartily appreciate if you could help me please, thank you & best regards
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#13
I tried .Pattern = "(Email[:]([a-z0-9.]*)@([a-z0-9.]*))" but the code fails to run. As there are some spaces after Email: I think there might be a line break as well that causing code to fail, I will heartily appreciate if you could help me please, thank you & best regards
if there are spaces between email: and the address, try \s*. if there is a space following the address, use either "(Email[:]([a-z0-9.]*)@([a-z0-9.]*) )" or "(Email[:]([a-z0-9.]*)@([a-z0-9.]*)\s)"

(Sorry, I missed this earlier - I'm assuming you got it working by now, I added my comments for the benefit of others.)
 
Top