Script in rule to send to multiple emails found in message bo

Status
Not open for further replies.

GregB

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server 2010
I have used the many helpful threads in this forum and almost have my script working.

I receive an automated email from a system and want to grab all emails from a specific domain listed within the message body and forward the message to these addresses. The code below works but if I find 3 address matches it send 3 emails. If I use the second code listed I can get all the addresses in a string separated by semi-colons. But it does not like adding the string to the recipients list.


PHP:
Sub First(Item As Outlook.MailItem)
 
     Dim Reg1 As RegExp
 
     Dim M1 As MatchCollection
 
     Dim M As Match
 
     
     Set Reg1 = New RegExp
 
      Dim strAlias As String
 
   
    With Reg1
 
      
        '.Pattern = "([a-z0-9.]*)@([a-z0-9.]*)"
         .Pattern = "([a-z0-9.]*)@candu.com"
 
         .Global = True
 
     End With
 
     If Reg1.test(Item.Body) Then
 
         Set M1 = Reg1.Execute(Item.Body)
 
         For Each M In M1
 
           strAlias = M '& ";" & strAlias
 
           'MsgBox "reg1: " & strAlias
           'Item.Subject = "Test"
           
            Set MyForward = Item.Forward
           
strSubj = Replace(MyForward.Subject, "FW: ", "")
 
    MyForward.Subject = strSubj
   
MyForward.Recipients.Add strAlias
  MyForward.Send
  'Item.Save
         Next




     End If

 'MsgBox "reg2: " & strAlias
 
 
End Sub


Code to try and send to all discovered addresses in one email.


PHP:
Sub First(Item As Outlook.MailItem)
 
     Dim Reg1 As RegExp
 
     Dim M1 As MatchCollection
 
     Dim M As Match
 
     
     Set Reg1 = New RegExp
 
      Dim strAlias As String
 
   
    With Reg1
 
      
        '.Pattern = "([a-z0-9.]*)@([a-z0-9.]*)"
         .Pattern = "([a-z0-9.]*)@mydomain.com"
 
         .Global = True
 
     End With
 
     If Reg1.test(Item.Body) Then
 
         Set M1 = Reg1.Execute(Item.Body)
 
         For Each M In M1
 
           strAlias = M & ";" & strAlias
 
           'MsgBox "reg1: " & strAlias
           'Item.Subject = "Test"
           
          
  'Item.Save
         Next


 
     End If

 MsgBox "reg1: " & strAlias
 
  Set MyForward = Item.Forward
           
strSubj = Replace(MyForward.Subject, "FW: ", "")
 
    MyForward.Subject = strSubj
   
MyForward.Recipients.Add strAlias
  MyForward.Send
 
End Sub


I have tried code below but not sure I have it just right.


For i = 0 To UBound(Split(strAlias, ";"))
Set ToForward = MyForward.Recipients.Add(Split(strAlias, ";")(i))
ToForward.Type = ItemTo
Next i


Thanks
 
What happens when you use the string? As long as it's semicolon delimited, it should work.
Nothing..that is the strange part. I run the rule against an email and the Msgbox shows 3 addresses separated by semi-colon. I hit OK and nothing happens. If I paste the string into an email it works fine. Running the top script works no problem.
 
Try Michael's suggestion and change this
MyForward.Recipients.Add strAlias
to
MyForward.To strAlias
 
Try Michael's suggestion and change this
MyForward.Recipients.Add strAlias
to
MyForward.To strAlias
I will try that. A quick second. How do I add in a hyphen in the pattern for email address's?
 
adding the dash after the . should work
"([a-z0-9.-]*)@([a-z0-9.]*)"

you might want to use this to cover all bases
"([a-z0-9._%+-]*)@([a-z0-9.-]*)"
 
That worked for the hyphen. Thank-you

The other is still not working.
Her is the code I am using
PHP:
Sub First(Item As Outlook.MailItem)
 
     Dim Reg1 As RegExp
 
     Dim M1 As MatchCollection
 
     Dim M As Match
 
     
     Set Reg1 = New RegExp
 
      Dim strAlias As String
 
   
    With Reg1
 
      
        '.Pattern = "([a-z0-9.]*)@([a-z0-9.]*)"
         .Pattern = "([a-zA-Z0-9.]*)@mydomain.com"   'find all  email addreses within email
 
         .Global = True
 
     End With
 
     If Reg1.test(Item.Body) Then
 
         Set M1 = Reg1.Execute(Item.Body)
 
         For Each M In M1
 
          strAlias = M & ";" & strAlias
 
           'MsgBox "reg1: " & strAlias
         
           
         
        Next


    End If
 
Set MyForward = Item.Forward
           
    strSubj = Replace(MyForward.Subject, "FW: ", "") ' Remove the FW from the subject
 
    MyForward.Subject = strSubj
   
    MsgBox "reg1: " & strAlias ' this shows recipient.first@mydomain.com;recipient.second@mydomain.com;recipient.third@mydomain.com;
   
    MyForward.To strAlias
 
'delete the top lines of the Forward message
strRemove = Left(MyForward.HTMLBody, InStr(1, MyForward.HTMLBody, "Message to user") + Len("Subject:") + Len(MyForward.Subject) + 25)
  MyForward.HTMLBody = Replace(MyForward.HTMLBody, strRemove, "")
 
  MyForward.Send


End Sub
 
I'm getting an error on myforward.to, but using recipients.add works - but it takes a few seconds for the addresses to resolve.

will the messages be html or plain text? html adds each address twice as it reads the html code. you can use an if to trap dupe:

For Each M In M1
If Not M = strAlias Then
strAlias = M
myforward.Recipients.Add strAlias
End If



This works... it needs tidied up a bit.

Code:
Sub First(Item As Outlook.MailItem)
     Dim Reg1 As RegExp
     Dim M1 As MatchCollection
     Dim M As Match
     Dim myforward As MailItem
     Dim objRecip As Recipient
   
     Set Reg1 = New RegExp
      Dim strAlias As String
    
Set myforward = Item.Forward

     With Reg1
         .Pattern = "([a-z0-9.]*)@([a-z0-9.]*)"
        ' .Pattern = "([a-zA-Z0-9.]*)@mydomain.com"   'find all  email addreses within email
         .Global = True
     End With
     If Reg1.test(Item.Body) Then
         Set M1 = Reg1.Execute(Item.Body)
         For Each M In M1
          strAlias = M
              myforward.Recipients.Add strAlias
         Next
     End If
 
With myforward
   
strSubj = Replace(myforward.Subject, "FW: ", "") ' Remove the FW from the subject
   .Subject = strSubj

'delete the top lines of the Forward message
strRemove = Left(.Body, InStr(1, .Body, "Message to user") + Len("Subject:") + Len(.Subject) + 25)
  .HTMLBody = Replace(.HTMLBody, strRemove, "")
' .Display
End With

For Each objRecip In myforward.Recipients
objRecip.Resolve
Next

myforward.Send

     Set Reg1 = Nothing
     Set myforward = Nothing
    
End Sub
 
BTW, if you want to resolve the addresses as you add them, use this instead of the one before the send.
If Not M = strAlias Then
strAlias = M
Set objRecip = myforward.Recipients.Add(strAlias)
objRecip.Type = olTo
objRecip.Resolve
End If
 
Thank you very much it is all working.
 
BTW, if you want to resolve the addresses as you add them, use this instead of the one before the send.
If Not M = strAlias Then
strAlias = M
Set objRecip = myforward.Recipients.Add(strAlias)
objRecip.Type = olTo
objRecip.Resolve
End If


I am having a strange issue. Every once in a while the script pops up an error to the effect that a message must have a to:. cc or bcc in the message. I have see somewhere code to check for this and send to a specific address (if you can point out the link that would be great).

More importantly it seems that if this happens and the user logged in is not around someone else logs into the machine to try and fix. Regardless when the original account logs in the script will no longer run. I try to manually run but a quick flash of a message happens and nothing. It seems something is corrupt in the profile? to fix before I have to get a new user to log into PC to have the script run as them. very frustrating. any ideas? Thanks
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
K Run a script rule to auto 'send again' on undeliverable emails? Outlook VBA and Custom Forms 1
Diane Poremsky Run a Script Rule: Send a New Message when a Message Arrives Using Outlook 2
S Script to use in a rule when a message arrives to send to email in the message Outlook VBA and Custom Forms 12
G Save attachment run a script rule Outlook VBA and Custom Forms 0
E Having some trouble with a run-a-script rule (moving mail based on file type) Outlook VBA and Custom Forms 5
dweller Outlook 2010 Rule Ignores VBA Script Outlook VBA and Custom Forms 2
B Outlook rule run a Script doesn't work Outlook VBA and Custom Forms 1
Bri the Tech Guy Run Script rule not running for newly arriving messages Outlook VBA and Custom Forms 25
Vijay Error in rule- Run a script Using Outlook 1
L Run a Script Rule doesn't work Using Outlook 5
S using script rule to save attachments on arrival Outlook 2010 Outlook VBA and Custom Forms 9
L Cannot run script from rule Outlook VBA and Custom Forms 7
O modify vba to run it as script rule Outlook VBA and Custom Forms 8
L Moving Message Class email via script and Rule Outlook VBA and Custom Forms 3
A Creating archive rule on the clients by script/ Outlook VBA and Custom Forms 3
Jeff Rott Diane Question on "Use in a Run a Script Rule" Outlook VBA and Custom Forms 1
M Outlook Rule To Redirect Mail - Script to overcome lack of cc's & others Using Outlook 0
S Outlook VBA rule script to process both MailItem and MeetingItem Using Outlook 0
D Troubleshooting rule/script not running Outlook VBA and Custom Forms 5
H Rule Wizard and script to initiate e-mail Outlook VBA and Custom Forms 2
L Run script rule not exectued for first few mails Outlook VBA and Custom Forms 2
R Script for simplifying spam control Outlook VBA and Custom Forms 8
J Outlook Rules VBA Run a Script - Multiple Rules Outlook VBA and Custom Forms 0
N Outlook 2021 'Run Script" Rules? Outlook VBA and Custom Forms 4
W Designer Form 2013 and Script ? how ? Outlook VBA and Custom Forms 1
G print attachment straight away; working script edit not working Outlook VBA and Custom Forms 0
FryW Need help modifying a VBA script for in coming emails to auto set custom reminder time Outlook VBA and Custom Forms 0
G Script does not exist Outlook VBA and Custom Forms 0
G Trigger script without restaring outlook Outlook VBA and Custom Forms 7
A VBA Script - Print Date between first email in Category X and last email in Category Y Outlook VBA and Custom Forms 3
L Modifying VBA script to delay running macro Outlook VBA and Custom Forms 3
L Need help modifying a VBA script for emails stuck in Outbox Outlook VBA and Custom Forms 6
L VB script only runs manually Outlook VBA and Custom Forms 5
D.Moore VB script to Digitaly Sign newly created outlook message Outlook VBA and Custom Forms 2
Aussie Rules Run a Script on an Incoming Email OK and then the Email reverts Outlook VBA and Custom Forms 0
D.Moore VBA script fail after Office 365 update Using Outlook 8
M Outlook 2013 Script Assistance - Save Opened Link with Subject Added Outlook VBA and Custom Forms 1
F Script for zip file attachment Outlook VBA and Custom Forms 1
S Change VBA script to send HTML email instead of text Outlook VBA and Custom Forms 3
Y Outlook 2013 Run A Script Outlook VBA and Custom Forms 4
Z Script to set account? Using Outlook 0
N VBA Script to Open highlighted e-mail and Edit Message Outlook VBA and Custom Forms 5
J Calling a Public sub-routine from the script editor via VB script Outlook VBA and Custom Forms 4
K Outlook Archive to PST Files by Date Range VBA Script? Outlook VBA and Custom Forms 1
Peter H Williams Enable script containing VBA Outlook VBA and Custom Forms 12
H VB script in outlook form doesn't work anymore Outlook VBA and Custom Forms 2
A Script to fetch data from mails in restricted collection and sending them to excel Using Outlook 1
B Wanting to run a script that will filter any body that has a russian link in it. Outlook VBA and Custom Forms 5
Bri the Tech Guy Registry Tweak to make "Run a Script" Action Available Outlook VBA and Custom Forms 2
V VB script code to save a specific email attachment from a given email Outlook VBA and Custom Forms 14

Similar threads

Back
Top