VB Script, remove text from subject line when forwarding

[fourthgen]

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

 

[Diane Poremsky]

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.

 

[fourthgen]

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

 

[Diane Poremsky]

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

 

[fourthgen]

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.

 

[Diane Poremsky]

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

 

[fourthgen]

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?

 

[Diane Poremsky]

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)

 

[fourthgen]

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).

 

[Diane Poremsky]

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.)

 

[fourthgen]

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'

 

[Diane Poremsky]

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.

 

[fourthgen]

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?

 

[Diane Poremsky]

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

 

[fourthgen]

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..

 

[Diane Poremsky]

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

 

[fourthgen]

That is perfect! Thank you

 

[aom]

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!

 

[Diane Poremsky]

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.

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

 

[aom]

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.