Forward Outlook Email by Filtering using Macro Rule

Status
Not open for further replies.

Alfie Panelo

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
Hello All,

I'm having trouble coding Regex with vba

Can anyone help me with missing part to make the Outlook VBA script below work?

What I'm trying to do is filter the email body that contains a less than symbol <, it will forward to a specific email address.

Here is so far what I have.

Public Sub FWItem(Item As Outlook.mailitem)
Dim Email As Outlook.mailitem
Dim Matches As Variant
Dim RegExp As Object
Dim Pattern As String

Set RegExp = CreateObject("VbScript.RegExp")

If TypeOf Item Is Outlook.mailitem Then

Pattern = "(\s[<]\s)"
With RegExp
.Global = False
.Pattern = Pattern
.IgnoreCase = True
Set Matches = .Execute(Item.Body)
End With

If Matches.Count > 0 Then
Debug.Print Item.subject ' Print on Immediate Window
Set Email = Item.Forward
Email.subject = Item.subject
Email.Recipients.Add "alias@domain.com"
Email.Save
Email.Send

End If
End If

Set RegExp = Nothing
Set Matches = Nothing
Set Email = Nothing
Set Item = Nothing
End Sub


Here is a sample email text:

"That was fast! It only took < 60 seconds to reboot the modem."

If there is a space between < and 60, it will forwarded to my email but if there are no space, it won't.

Thank you,
 
Hello Diane,

Thank you for your swift response. Yes, I want both <60 and < 60 to be forwarded. Will try your suggestion and will keep you posted.

Regards,
 
Hi Diane,

I applied your suggestion on my Macro Rule. Both are now working. However, even though there is no < symbol on the email body, it was still forwarding to my email.

Regards,
 
Even with this pattern? Pattern = "(\s[<])" or try Pattern = "(\s<)"
 
Ah... I think i might know... it looks like it is finding < in the html code. so without the \s, it's finding everything. Is there anything else unique in the message you can look for, to help restrict it to these specific messages?
 
Hello Diane,

Thank you for helping me here. Only < that I need to filter on the email body.

Regards,
 
if you add msgbox Item.Body near the top of the code, you'll see it is using the raw body - not just what you see on the screen. Converting the message to plain text might work but if the messages you need to check are always plain text, you can check for the format first, then skip any that are html.

Code:
If TypeOf Item Is Outlook.mailitem Then
Item.BodyFormat = olFormatPlain
strBody = item.body 

Pattern = "(\s[<]\s)"
With RegExp
.Global = False
.Pattern = Pattern
.IgnoreCase = True
Set Matches = .Execute(strBody)
End With


or, if the message you need to forward are already plain text, use this:
If TypeOf Item Is Outlook.mailitem And Item.BodyFormat = olFormatPlain Then


BTW, to make it easier to test without sending messages and running rules, use this little stub macro - select a message and then run this macro - it will process the current item using the run a script macro. I usually change the script I'm testing to display the message, rather than sending it, so i don't spam myself.

Code:
Sub RunScript()
Dim objApp As Outlook.Application
Dim objItem As MailItem
Set objApp = Application
Set objItem = objApp.ActiveExplorer.Selection.Item(1)

'macro name you want to run goes here
FWItem objItem

End Sub
 
Hello Diane,

Will try this and will keep you posted.

Thank you,
 
Hi Diane,

I tried what you have suggested above. The good thing is, all email that I received is now converted to Plain Text but even the mail body contains <, it will now not forwarded to my email.

BTW, i used the code below for my pattern:

If TypeOf Item Is Outlook.mailitem and Item.BodyFormat = olFormatPlain Then

strBody = item.body

Pattern = "(\s[<]\s)"
With RegExp
.Global = False
.Pattern = Pattern
.IgnoreCase = True
Set Matches = .Execute(strBody)
End With

Also, I tried this code but, when the email converted to Plain text, there are too many < in the email body.

If TypeOf Item Is Outlook.mailitem Then

Item.BodyFormat = olFormatPlain
strBody = item.body

Pattern = "(\s[<]\s)"
With RegExp
.Global = False
.Pattern = Pattern
.IgnoreCase = True
Set Matches = .Execute(strBody)
End With

FYI, we are using HTML Format.

Thank you,
 
so when you convert to plain text, it wraps the url in <> ? It worked in my quickie test. :(

It looks like you have two choices - use rules or the script to filter the mail so the only mail processed by the script are ones that might have the < in the body or expand the pattern if the phrase is always the same.

Pattern = "(\s[<]\s?[0-9]*)" should pick up anything from <1 to < 1000 (to infinity). This definitely won't get the urls.
 
This seems to be working ok here in my limited tests - i have it popping up a message box if the macro runs but doesn't have the < in the body. I also limited the number to 2 digits - it should work with any number of digits but won't find single digits.

Code:
Public Sub FWItem(Item As Outlook.MailItem)
Dim Email As Outlook.MailItem
Dim Matches As Variant
Dim RegExp As Object
Dim Pattern As String

Set RegExp = CreateObject("VbScript.RegExp")

If TypeOf Item Is Outlook.MailItem Then

Pattern = "(\s[<]\s?[0-9]{2})"
With RegExp
.Global = False
.Pattern = Pattern
.IgnoreCase = True
Set Matches = .Execute(Item.Body)
End With

If Matches.Count > 0 Then
Debug.Print Item.Subject ' Print on Immediate Window
Set Email = Item.Forward
Email.Subject = Item.Subject
Email.Recipients.Add "alias@domain.com"
Email.Save
Email.Display
Else
MsgBox "no match"

End If
End If

Set RegExp = Nothing
Set Matches = Nothing
Set Email = Nothing
Set Item = Nothing
End Sub
 
Hi Diane,

Thank you for this. I will try this again and will keep you posted.

I appreciate your help here.

Regards,
 
Diane, ANY help is greatly appreciated as I have a similar request from an Outlook 2013 user that wants me to create a script that can be used by an Outlook rule that would detach a file from an e-mail and store that file in a specific location. I've done tons of searches, enabled macros and setup a test rule:
From Specific email address
Which has an attachment
Run script

But I think my script is wrong because nothing ever happens (copied and edited from internet):


Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

On Error GoTo ErrorHandler

'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item

'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderName = "Michael") And _
(Msg.Subject = "test") And _
(Msg.Attachments.Count >= 1) Then

'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim Att As String

'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "\\servername\subfolder"


' save attachment
Set myAttachments = item.Attachments
Att = myAttachments.item(1).DisplayName
myAttachments.item(1).SaveAsFile attPath & Att

' mark as read
Msg.UnRead = False
End If
End If


ProgramExit:
Exit Sub

ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
Sub myRuleMacro(item As Outlook.MailItem)
End Sub
End Sub


End Sub

I'm not great with scripting, so not sure if I need to include quotes, extra slashes, etc. for users and locations. Am I missing something here??
 
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
This part tells me it's an item add rule and will run automatically when outlook starts. it works by watching the folder set here: Set Items = objNS.GetDefaultFolder(olFolderInbox).Items - in this case, the default inbox.

The macro should error on this - you have a sub within a sub.
--snip--
Sub myRuleMacro(item As Outlook.MailItem)
End Sub
End Sub


End Sub

The run a script rule at Save and Rename Outlook Email Attachments should work - create the conditions in the rule and send them to the script. you need to change the save to path and if you only want to save certain attachment types, tweak it for that too. Oh, and remove the part that changes the saved file name.
 
This should work - sometimes outlook will hang or fail with network paths - you might need to use a mapped drive path.

Code:
Public Sub saveAttachtoDiskRule(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim file As String

saveFolder = "\\Servername\foldername\test\"

' after you confirm it work without errors
' remove the ' from the next line
' On Error Resume Next

For Each objAtt In itm.Attachments
file = saveFolder & objAtt.DisplayName
objAtt.SaveAsFile file

Set objAtt = Nothing
Next
 
End Sub
 
This should work - sometimes outlook will hang or fail with network paths - you might need to use a mapped drive path.

Code:
Public Sub saveAttachtoDiskRule(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim file As String

saveFolder = "\\Servername\foldername\test\"

' after you confirm it work without errors
' remove the ' from the next line
' On Error Resume Next

For Each objAtt In itm.Attachments
file = saveFolder & objAtt.DisplayName
objAtt.SaveAsFile file

Set objAtt = Nothing
Next
 
End Sub


Diane, just so I'm understanding you...is ONLY this code needed in my script along with my previous rules I mentioned in order to work properly? Oh, and does the code go in the module or 'thisoutlooksession' script? (sorry, not a VB guy!)
 
Yes, you only need this code - I recommend putting it in a module, but it will work from thisoutlooksession.
 
Yes, you only need this code - I recommend putting it in a module, but it will work from thisoutlooksession.

upload_2017-6-6_14-37-13.png

If I do a "run rules now" nothing happens at all, no files move anywhere, regardless of whether I do it drive letter or \\servername\folder. Anything I could be overlooking?
 
Is there any way to see where it fails? I quickly see the file transfer animation in a blink, but it's not actually copying anything nor does it give an error.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
D Outlook VBA forward the selected email to the original sender’s email ID (including the email used in TO, CC Field) from the email chain Outlook VBA and Custom Forms 2
L Fetch, edit and forward an email with VBA outlook Outlook VBA and Custom Forms 2
richardwing Auto forward email that is moves into a specific outlook folder Outlook VBA and Custom Forms 5
B Forward every other email in Outlook 2013 Outlook VBA and Custom Forms 2
A Creating an outlook rule to forward an email with a specific message Using Outlook 1
A Outlook 2010 - Want to Have All Email Reply Forward as Rich Test Using Outlook 7
M In Outlook Calendar remove the buttons: 'Today' and '<' (Back a day) and '>' (Forward a day) that are below the Ribbon and above the calendar display. Using Outlook 0
M Outlook macro to automate search and forward process Outlook VBA and Custom Forms 6
N Going Forward: Using Outlook 2016 for RSS Feeds Using Outlook 2
N Outlook script to forward emails based on senders' address Outlook VBA and Custom Forms 2
J Outlook 2010: can't forward appointment on custom form Using Outlook 1
T outlook 2013 does not mark multiple forward messages as forward Using Outlook 2
S Outlook 2k/2k3 Reply or Forward: Signature image replaced by original sender Using Outlook 3
S Outlook 2003 Prefix on reply and forward Using Outlook 1
K How to auto truncate a message to forward with Outlook Rules Using Outlook 6
V major issue in outlook "Change in forward mail also change selected mail " Outlook VBA and Custom Forms 1
A why outlook change forward mail Outlook VBA and Custom Forms 2
H Forward E-mails at Certain Times in Outlook using VBA Outlook VBA and Custom Forms 1
T forward event in outlook with c# Outlook VBA and Custom Forms 1
A Forward mails with "FW:" or "RE:" in title Using Outlook 2
J Outlook 365 Forward Email Subject to my inbox when new email arrive in shared inbox Using Outlook 0
D Outlook 365 Forward Meeting Related Messages to Specific Meeting Organizer Outlook VBA and Custom Forms 0
T Customized form: The Forward option shows write layout Outlook VBA and Custom Forms 0
Z VBA Forward vs manual forward Outlook VBA and Custom Forms 2
A Outlook 2016 Macro to Reply, ReplyAll, or Forward(but with composing new email) Outlook VBA and Custom Forms 0
F Forward incoming email with 4 embedded images in the body without original sender Outlook VBA and Custom Forms 22
David McKay VBA to manually forward using odd options Outlook VBA and Custom Forms 1
S Auto forward for multiple emails Outlook VBA and Custom Forms 0
G Forward email body to other mail list directly from Exchange server Exchange Server Administration 1
D auto forward base on email address in body email Outlook VBA and Custom Forms 0
Bering Forward selected email without the original email appended Outlook VBA and Custom Forms 0
C UDFs Reply vs Forward Outlook VBA and Custom Forms 3
J Automatically forward email and apply template Outlook VBA and Custom Forms 0
O Forward a email with modified body Automatically. Outlook VBA and Custom Forms 0
C How to rename subject line and forward the email Outlook VBA and Custom Forms 2
R Error when trying to forward current email item Outlook VBA and Custom Forms 7
G Missing forward/replied icons Using Outlook 2
M VBA to auto forward message with new subject and body text Outlook VBA and Custom Forms 8
B Automatically Forward Emails and Remove/Replace All or Part of Body Outlook VBA and Custom Forms 8
M Forward Appointment as BCC with VBScript Outlook VBA and Custom Forms 7
D Disable or hide "reply" and "reply to all" and "forward" in email from access vba Outlook VBA and Custom Forms 1
Sabastian Samuel HOW DO I FORWARD AN EMAIL WITH MACRO using an email that in the body of another email Outlook VBA and Custom Forms 3
C Don't forward duplicate Using Outlook 0
undercover_smother Automatically Forward All Sent Mail and Delete After Send Outlook VBA and Custom Forms 10
I change subject and forward without FW: Outlook VBA and Custom Forms 4
C VBA to Forward e-mails from certain address and between certain times Outlook VBA and Custom Forms 1
J Forward Action in Form Outlook VBA and Custom Forms 1
J Auto Forward - Include Attachment and change Subject depending on original sender Outlook VBA and Custom Forms 3
K add pdf to every reply or forward Outlook VBA and Custom Forms 1
Brostin Forward a mail to the address listed in the email text Outlook VBA and Custom Forms 1

Similar threads

Back
Top