VB Script, remove text from subject line when forwarding

Status
Not open for further replies.

fourthgen

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Hi,

We have a SPAM filter in place and if it detects what it believes to be 'SPAM' it redirects the email to a quarantine mailbox. This is routinely checked and any genuine emails get forwarded out.

However, when it redirects to the quarantine mailbox, it adds either ****SPAM**** , [-SPAM-] or [-SPAM--] into the subject line (depending on type of email).

What I would like is a macro to run (or even a new send button) to remove the SPAM headings in the subject line automatically when forwarded.

Is this possible?

Thanks in advance
 
What is doing the forwarding? Is the quarantine mailbox open in someone's profile? Macros won't run if the mailbox is not open in a profile.

The macros at http://www.slipstick.com/outlook/rules/run-script-rule-change-subject-message/ should get you in the right direction. For the change subject part, you'll need to use If statements:

If left(item.subject, 12) = "****SPAM****" then
item.subject = right(item.subject, len(item.subject - 12)

else

If left(item.subject, 8) = "[-SPAM-]" then
item.subject = right(item.subject, len(item.subject - 8)

or Case statements.
 
Thank you for the response.

Currently, the Quarantine mailbox is open in someones profile, along with their own mailbox. What they do is, they go through the quarantine every so often to check for legitimate emails and the forward them out, doing this, they should be removing the SPAM parts of the subject field, but usually they forget, resulting in the emails returning to the quarantine folder, or it in turn gets sent to the recipients with SPAM still in the subject, resulting in many people just deleting it without reading the email first.

So what i am looking for is a way to eliminate / reduce the risk of human error
 
Would they remember to click a special Forward button? It is possible to capture the Forward click but might be less complicated to use a special button.

Do you need to pick up the recipients address? I'm assuming its in the message in the normal outlook header block of

-----Original Message---
From: name and address

Sent: date

To: name

Subject: subject
 
If it is possible then a special forward button would be perfect!

Well at the moment they manually type in the recipients address, but if it is possible to pick it up from the header block, that would be extremely useful. And yes, it is in the message in the normal header block as in your example.
 
Test this - forward quarentines - i tested it on one message i added the spam tag to before forwarding it to another mailbox.

This code assumes the --original message-- block in the message sent to the quarantine folder does not have the spam tag in it - if it has the spam tag, then that will need cleaned in the code
 
Sorry, im not the best with VB Script.

So if i use the link you supplied

Sub ChangeSubjectThenForward()

Dim oItem As Outlook.MailItem

Dim strSendto, strSubject As String

Dim myForward As MailItem


' Set reference to VB Script library

' Microsoft VBScript Regular Expressions 5.5
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim Reg2 As RegExp
Dim M2 As MatchCollection
Dim M As Match

Set oItem = ActiveExplorer.Selection.Item(1)

Set myForward = ActiveExplorer.Selection.Item(1).Forward
' regex from http://slipstick.me/2k3zf
' check the original, not the forward
Set Reg1 = New RegExp
With Reg1
.Pattern = "(To[:](.*))"
.Global = True
End With
If Reg1.test(oItem.Body) Then

Set M1 = Reg1.Execute(oItem.Body)
For Each M In M1
strSendto = M.SubMatches(1)
Next
End If

Set Reg2 = New RegExp
With Reg2
.Pattern = "(Subject[:](.*))"
.Global = True
End With
If Reg2.test(oItem.Body) Then

Set M2 = Reg2.Execute(oItem.Body)
For Each M In M2
strSubject = M.SubMatches(1)
Next
End If
myForward.Recipients.Add strSendto
myForward.Subject = strSubject
myForward.Display

where would I add in the IF statements to remove the SPAM headings?
 
If the quarantined message has this:

-----Original Message---
From: [sender name]

Sent: [date]

To: [recipient]

Subject: ****Spam**** [subject]

myForward.Subject = strSubject will result in a subject of "****Spam**** [subject]"

so... between getting the strSubject value and that line, you need to clean it.

I'd use this - I added Trim to remove any leading spaces so you can use 1 line for the two similar tags, that is assuming there is a space between the tag and the subject.
Set M2 = Reg2.Execute(oItem.Body)
For Each M In M2
strSubject = Trim(M.SubMatches(1))

Next
End If

If Left(LCase(strSubject), 8) = "****spam" Then
strSubject = Right(strSubject, Len(strSubject) - 12)

End If

If Left(LCase(strSubject), 6) = "[-spam" Then
strSubject = Right(strSubject, Len(strSubject) - 9)

End If
myForward.Recipients.Add strSendto
myForward.Subject = Trim(strSubject)
 
Thank you,

I am trying that script:

Sub ChangeSubjectThenForward()

Set M2 = Reg2.Execute(oItem.Body)

For Each M In M2

strSubject = Trim(M.SubMatches(1))

Next

End If

If Left(LCase(strSubject), 8) = "****spam" Then

strSubject = Right(strSubject, Len(strSubject) - 12)

End If

If Left(LCase(strSubject), 6) = "[-spam" Then

strSubject = Right(strSubject, Len(strSubject) - 9)

End If

myForward.Recipients.Add strSendto

myForward.Subject = Trim(strSubject)

End Sub

But when I go to run it, the Debug comes up highlighting the first "End If" (in red above). If i take this out, the Debug then highlights the first line of the script (in blue above).
 
Did you replace the block of code in the working macro posted earlier with the code block I posted? Everything between

Set M2 = Reg2.Execute(oItem.Body)

and

myForward.Subject = strSubject

was to be replaced.
(When a complete macro is posted online or written in books it is wrapped by sub/end sub - otherwise it is an incomplete code snippet.)
 
My apologise, I mis read the previous post.

I have now got:

Sub ChangeSubjectThenForward()

Dim oItem As Outlook.MailItem

Dim strSendto, strSubject As String

Dim myForward As MailItem

' Set reference to VB Script library

' Microsoft VBScript Regular Expressions 5.5

Dim Reg1 As RegExp

Dim M1 As MatchCollection

Dim Reg2 As RegExp

Dim M2 As MatchCollection

Dim M As Match

Set oItem = ActiveExplorer.Selection.Item(1)

Set myForward = ActiveExplorer.Selection.Item(1).Forward

' regex from http://slipstick.me/2k3zf

' check the original, not the forward

Set Reg1 = New RegExp

With Reg1

> Pattern = "(To[:](.*))"

> Global = True

End With

If Reg1.test(oItem.Body) Then

Set M1 = Reg1.Execute(oItem.Body)

For Each M In M1

strSendto = M.SubMatches(1)

Next

End If

Set Reg2 = New RegExp

With Reg2

> Pattern = "(Subject[:](.*))"

> Global = True

End With

If Reg2.test(oItem.Body) Then

Set M2 = Reg2.Execute(oItem.Body)

For Each M In M2

strSubject = Trim(M.SubMatches(1))

Next

End If

If Left(LCase(strSubject), 8) = "****spam" Then

strSubject = Right(strSubject, Len(strSubject) - 12)

End If

If Left(LCase(strSubject), 6) = "[-spam" Then

strSubject = Right(strSubject, Len(strSubject) - 9)

End If

myForward.Recipients.Add strSendto

myForward.Subject = Trim(strSubject)

myForward.Display

End Sub

When I try and run this, i get this error: "Compile error: User-defined type not defined" and it highlights 'Dim Reg1 As RegExp'
 
Sorry about that - I forgot to remind you to you set a reference -

' Set reference to VB Script library
' Microsoft VBScript Regular Expressions 5.5

in Tools, References.
 
Ahh many thanks for that. I have another client that is similar, but they do not want to manually type the recipient each time. So what wiould i need to remove to get it to work that way also?
 
They want to type the recipient or don't want to type it? The code gets the recipient right now. To not get the recipient from the message, delete or comment out this line:

myForward.Recipients.Add strSendto
 
Apologise, I have only just had the time to test this on the quarantine mailbox (was testing on my own mailbox before) .. There is a problem, as the emails do not get forwarded to the quarantine, they get redirected (so it appears as the intended recipient was quarantine@) as this is the case, the script does not copy the subject over..
 
In that case, you don't need Reg2, you just need something like this - where you pick up the subject from the original message:

If Left(LCase(oitem.subject), 8) = "****spam" Then
strSubject = Right(oitem.subject, Len(oitem.subject) - 12)
End If
 
Hello, I have a similar issue and this was the closest thread I could find regarding it.

Right now, our spam filters will add [LIKELY_SPAM] to any email's subject line that it thinks may be spam, then it will deliver it to the user's Inbox (Exchange 2007/Outlook 2010).

The users are OK with this setup, EXCEPT, if they were to reply to that email, we'd like some kind of Outlook 2010 script that will automatically remove the text [LIKELY_SPAM] from the email's subject line when being sent from their Outlook client.

Thanks so much in advance for any help/guidance!
 
You can do that with a macro - although if a lot of users need it, compiling it into a com addin would be better (it's easier to distribute).

There are two options for macros - checking it as the message sends or checking it when the message opens. Checking whern the message opens is probably trhe easiest - i have a sample here http://www.slipstick.com/developer/code-samples/insert-attachment-names-replying/ that checks for attachment names. changing it to check the subject is fairly easy.
replace everything between the sun name and end sub with this - changing the oitem.reply to replyall for the replyall macro.

Code:
Cancel = True
  bDiscardEvents = True
  Dim oResponse As MailItem
  Set oResponse = oItem.Reply
 
If Left(LCase(oResponse.subject), 14) = "[likely_spam]" Then
strSubject = Right(oResponse.subject, Len(oResponse.subject) - 15)
End If

oResponse.Display

  bDiscardEvents = False
Set oItem = Nothing
 
Thank you so much Diane! Sorry for the late reply, I didn't get a notification. I'll review what you posted and will try to test things out of the next couple of days.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
A Remove personal contacts script Exchange Server Administration 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
K Run a script rule to auto 'send again' on undeliverable emails? Outlook VBA and Custom Forms 1
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
G Save attachment run a script rule 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
E Having some trouble with a run-a-script rule (moving mail based on file type) 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
dweller Outlook 2010 Rule Ignores VBA Script Outlook VBA and Custom Forms 2
N VBA Script to Open highlighted e-mail and Edit Message Outlook VBA and Custom Forms 5
B Outlook rule run a Script doesn't work Outlook VBA and Custom Forms 1
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
Bri the Tech Guy Run Script rule not running for newly arriving messages Outlook VBA and Custom Forms 25
M Subject Line Automation - Trigger Script Delayed Outlook VBA and Custom Forms 2
Q Script to create a pst file for Archiving Using Outlook 1
Vijay Error in rule- Run a script Using Outlook 1
R VBA Script Quick Parts Using Outlook 1
Vijay Run script doesn't work in outlook Using Outlook 1
Q VBA Script to move item in secondary mailbox Outlook VBA and Custom Forms 2
Diane Poremsky Run a Script Rule: Send a New Message when a Message Arrives Using Outlook 2
F Avoid sending duplicate using Outlook script Outlook VBA and Custom Forms 2
oliv- How to Run a Script IN AN ADDIN with Outlook's Rules and Alerts Outlook VBA and Custom Forms 2
L Run a Script Rule doesn't work Using Outlook 5
N Outlook script to forward emails based on senders' address Outlook VBA and Custom Forms 2
S using script rule to save attachments on arrival Outlook 2010 Outlook VBA and Custom Forms 9
X Outlook script to run excel data Outlook VBA and Custom Forms 1
N VBA Script to Send Automatic Emails from Outlook 2010 Outlook VBA and Custom Forms 1

Similar threads

Back
Top