Auto Remove [EXTERNAL] from subject - Issue with Macro

[dextryn]

Hello, I'm trying to get a macro working from a closed thread in this forum.
Here is the link to the thread.

My company recently instituted the policy that puts the [EXTERNAL] tag in every subject when an email is received from outside the organization. When it's only one email, it's not really an issue. However, when it turns into a thread you get [EXTERNAL]RE: [EXTERNAL]FW: [EXTERNAL] etc. To the point where you can't even read the subject without opening up the email.

I'd love to use this macro to strip the [EXTERNAL] from the subject line, and by that linked thread, it seems it's completely possible. Unfortunately, I'm brand new to the macro world and I need a lot of help.

I've set up the developer tab and hit the visual basic button, but after that I'm lost. I've tried to google "how to write a macro in outlook", but even that seems daunting. Could anyone help me set up the macro from the linked thread?

 

[Diane Poremsky]

This should do it - it's the macro with the edits. This runs on all messages in the folder. You need to run it.

These macros were updated and tested.

Sub RemoveExternalString()
Dim myolApp As Outlook.Application
Dim Item As Object

Set myolApp = CreateObject("Outlook.Application")
Set mail = myolApp.ActiveExplorer.CurrentFolder

' Remove from left or right
Dim iItemsUpdated As Integer
Dim lString As Integer

iItemsUpdated = 0
For Each Item In mail.Items
strSubject = LCase(Item.Subject)
If InStr(1, strSubject, "[external] ") Then
  Item.Subject = Replace(strSubject, "[external] ", "")
  olItem.Save
End If
Next Item

MsgBox iItemsUpdated & " of " & mail.Items.Count & " Messages Updated"
Set myolApp = Nothing
End Sub

This is an automatic version - watches all messages as they arrive in the inbox and remove external - it should replace all uses of it - so in your example of [EXTERNAL]RE: [EXTERNAL]FW: [EXTERNAL] Original subject, it should revert to RE: FW: original subject.

Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items

Private Sub Application_Startup()

Dim objFolder As Outlook.folder
Set objNS = Application.GetNamespace("MAPI")

'Use default Inbox to watch:
Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
Set objItems = objFolder.Items

Set objFolder = Nothing
End Sub


Sub objItems_ItemAdd(ByVal Item As Object)

strSubject = LCase(Item.Subject)
If InStr(1, strSubject, "[external] ") Then
  Item.Subject = Replace(strSubject, "[external] ", "")
  olItem.Save
End If
 
End Sub

How to use Outlook's VBA Editor

Basic instructions on using Outlook's VBA editor: how to open it, where to put the code, how to sign your code.

www.slipstick.com

 

[Diane Poremsky]

The earlier macros weren't working and I updated the previous post with code that does work.

 

[dextryn]

Thank you so much for the help! It runs this time, but I get a message that says "0 out of ##" messages have been updated. Is there something I did wrong? I clicked on "Visual Basic" in the Developer tab, right clicked on "Project1" and selected "Insert" - "Module". Then I just copied/pasted the code into the text box.
After that I went back into my outlook and selected a folder and clicked "Macros" and the selected "Project1.RemoveExternalString"
I have to correct one thing, the external tag is [External] not [EXTERNAL]. I changed it in the script but it still did not work.

 

[Diane Poremsky]

This:
strSubject = LCase(Item.Subject)
Takes care of different cases - upper, lower proper. Use lower case when looking for it and replacing -

If InStr(1, strSubject, "[external] ") Then
Item.Subject = Replace(strSubject, "[external] ", "")


You are using the new macros? I replaced my original ones with the ones above - or I thought I did - the manual one is not correct - its the one that gives you a count.

This part changed in the automatic one (the second one)

Sub objItems_ItemAdd(ByVal Item As Object)

strSubject = LCase(Item.Subject)
If InStr(1, strSubject, "[external] ") Then
  Item.Subject = Replace(strSubject, "[external] ", "")
  olItem.Save
End If
 
End Sub

This is the correct manual one - (also fixed above)

Sub RemoveExternalString()
Dim myolApp As Outlook.Application
Dim Item As Object

Set myolApp = CreateObject("Outlook.Application")
Set mail = myolApp.ActiveExplorer.CurrentFolder

' Remove from left or right
Dim iItemsUpdated As Integer
Dim lString As Integer

iItemsUpdated = 0
For Each Item In mail.Items
strSubject = LCase(Item.Subject)
If InStr(1, strSubject, "[external] ") Then
  Item.Subject = Replace(strSubject, "[external] ", "")
  olItem.Save
End If
Next Item

MsgBox iItemsUpdated & " of " & mail.Items.Count & " Messages Updated"
Set myolApp = Nothing
End Sub

 

[dextryn]

I'm not sure what I'm doing wrong. I've taken some screenshots to show how I have it and the error.
Is there a setting somewhere in Outlook where I need to give more permissions? I have "Enable all macros" selected (only for this purpose, I plan on digitally signing it and putting the protections back after I can figure this out).

 

[Diane Poremsky]

It's not macro permissions- it runs, so they are good. You have the inbox selected? Iwonder if it's the space - remove the space after external -
If InStr(1, strSubject, "[external]") Then
Item.Subject = Replace(strSubject, "[external]", "")

 

[dextryn]

That's it!!! It works!! Thank you so much for your help!

 

[dextryn]

Ok, actually. This is weird. Do you know why it would change the entire subject line to lowercase after it stripped out the External tag?

 

[Diane Poremsky]

oh shoot, back to the drawing board. You'll need to use the correct case and hope other companies don't use a different case....

If InStr(1, Item.Subject, "[EXTERNAL]") Then
Item.Subject = Replace(Item.Subject, "[EXTERNAL]", "")
Item.Save
End If


If you have messages with different external tags this should work -

strSubject = LCase(Item.Subject)
If InStr(1, strSubject, "[external]") Then
Item.Subject = Replace(Item.Subject, "[EXTERNAL]", "")
Item.Subject = Replace(Item.Subject, "[External]", "")
Item.Save
End If

 

[dextryn]

That's it. I really only need this in my organization as the external tag can multiply when replying several times in the same thread. This fixes the issue for me. Again, thank you so much for your help.

 

[fdd]

Hi - piggybacking on this thread and first of all, thank you for coming up with this solution! The macro works and updates the subject line on the reading pane but not on the preview pane. How do I make the subject line on both panes the same?

 

[Diane Poremsky]

Are you using conversation view? It doesn't update the conversation subject, only each individual message in the convo. To change the convo, you need to use redemption. I'll take a look at it.

 

[fdd]

Are you using conversation view? It doesn't update the conversation subject, only each individual message in the convo. To change the convo, you need to use redemption. I'll take a look at it.

Yes, using the convo view.

 

[Diane Poremsky]

You need redemption to make this work - get the developer version here -

Download Redemption

dimastr.com

Warning: this one does all messages in the selection to match the first message. (It was originally used to put messages in a thread if the subjects didn't match.) Don't use it to remove words if the messages are in multiple threads. They'll all have the same subject as the first one.

Public Sub RemoveExternalFromConversation()

Dim NewConversationTopic As String
Dim msg As MailItem
Dim msgSel As Selection
Dim oNS, objRDOitem As Object
Dim rdo As Redemption.RDOSession

Set msgSel = Nothing
Set msgSel = Application.ActiveExplorer.Selection

Set msg = msgSel.Item(1)

NewConversationTopic = Replace(msg.ConversationTopic, "(EXTERNAL)", "")

Set msg = Nothing

Set rdo = New Redemption.RDOSession
Set oNS = Nothing
Set oNS = Outlook.GetNamespace("MAPI")
oNS.Logon
rdo.MAPIOBJECT = oNS.MAPIOBJECT

For Each msg In msgSel
   Set objRDOitem = rdo.GetMessageFromID(msg.EntryID, msg.Parent.StoreID)
   objRDOitem.ConversationTopic = NewConversationTopic
   objRDOitem.Fields("http://schemas.microsoft.com/mapi/proptag/0x00710102") = Null
   objRDOitem.Save
   Set objRDOitem = Nothing
Next msg

Set msgSel = Nothing
Set msg = Nothing

End Sub

 

[Diane Poremsky]

BTW - the first one does all messages in the selection to match the first message. (It was originally used to put messages in a thread if the sujects didn't match.)

This one should work on the selection and change the subject and conversation correctly on the selected messages.

Public Sub RemoveExternalFromAll()

Dim NewConversationTopic As String
Dim msg As MailItem
Dim msgSel As Selection
Dim oNS, objRDOitem As Object
Dim rdo As Redemption.RDOSession
Dim iItemsUpdated As Integer

Set msgSel = Nothing
Set msgSel = Application.ActiveExplorer.Selection

Set rdo = New Redemption.RDOSession

Set oNS = Outlook.GetNamespace("MAPI")
oNS.Logon
rdo.MAPIOBJECT = oNS.MAPIOBJECT

iItemsUpdated = 0

For Each msg In msgSel

If InStr(1, msg.Subject, "[EXTERNAL] ") Then
  msg.Subject = Replace(msg.Subject, "[EXTERNAL] ", "")

   NewConversationTopic = msg.Subject

   Set objRDOitem = rdo.GetMessageFromID(msg.EntryID, msg.Parent.StoreID)
   objRDOitem.ConversationTopic = NewConversationTopic
   objRDOitem.Fields("http://schemas.microsoft.com/mapi/proptag/0x00710102") = Null
   objRDOitem.Save
 
   iItemsUpdated = iItemsUpdated + 1
End If
Next msg

MsgBox iItemsUpdated & " of " & msgSel.Count & " Messages Updated"

Set objRDOitem = Nothing
Set msgSel = Nothing
Set msg = Nothing
Set oNS = Nothing
End Sub

 

[fdd]

Thanks for getting back to me - truly appreciate it! Unfortunately, our IT policy the installation. I guess the work around is really to go without the conversation view.

 

[Diane Poremsky]

Thanks for getting back to me - truly appreciate it! Unfortunately, our IT policy the installation. I guess the work around is really to go without the conversation view.

I needed to do it anyway, so I can update the website with it.

 

[holleymc]

I also am piggybacking on this. THANK YOU for coming up with the macro to remove EXTERNAL. Works perfectly. My question is, is there a way to retain the capitilization of the remaining words in the subject field? After running the macro, EXTERAL was removed, but everything was in lower case. Here is the code I used:

Sub RemoveExternalString()
Dim myolApp As Outlook.Application
Dim Item As Object

Set myolApp = CreateObject("Outlook.Application")
Set mail = myolApp.ActiveExplorer.CurrentFolder

' Remove from left or right
Dim iItemsUpdated As Integer
Dim lString As Integer

iItemsUpdated = 0
For Each Item In mail.Items
strSubject = LCase(Item.Subject)
If InStr(1, strSubject, "[external]") Then
Item.Subject = Replace(strSubject, "[external] ", "")
Item.Save
End If
Next Item

MsgBox iItemsUpdated & " of " & mail.Items.Count & " Messages Updated"
Set myolApp = Nothing
End Sub

Thanks in advance!!

 

[Diane Poremsky]

If the case for external never changes, this will work - use the correct case for External.

For Each Item In mail.Items
strSubject = Item.Subject
If InStr(1, strSubject, "[External]") Then
Item.Subject = Replace(strSubject, "[External] ", "")
Item.Save
End If

I'll need to think on the best was to remove any case without affecting the rest of the subject.