Auto Remove [EXTERNAL] from subject - Issue with Macro

Status
Not open for further replies.

dextryn

Member
Outlook version
Outlook 365 64 bit
Email Account
Office 365 Exchange
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?
 
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.

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

Code:
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


 
Last edited:
The earlier macros weren't working and I updated the previous post with code that does work.
 
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.
 
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)
Code:
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)

Code:
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
 
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).
Macro1.png
macro2.png
 
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]", "")
 
That's it!!! It works!! Thank you so much for your help!
 
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?
 
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
 
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.
 
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?
 
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.
 
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.
 
You need redemption to make this work - get the developer version here -

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.

Code:
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
 
Last edited:
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.

Code:
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
 
Last edited:
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.
 
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. :)
 
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!!
 
If the case for external never changes, this will work - use the correct case for External.
Code:
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.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
P [SOLVED] Auto remove [EXTERNAL] from subject Using Outlook 16
A Auto Insert of filename when selecting 'Remove Attachment' Using Outlook 1
T Outlook 2010 manually actioning of send and receive? remove auto actioning Using Outlook 4
J Outlook's auto time zone update for meeting requestsHow to REMOVE or DISABLE? Using Outlook 1
H remove auto added signature macro Outlook VBA and Custom Forms 1
P Email address auto-completes work fine on laptop, but no longer on desktop Using Outlook 2
C New pc, new outlook, is it possible to import auto-complete emailaddress Using Outlook 4
R Outlook 365 VBA AUTO SEND WITH DELAY FOR EACH EMAIL Outlook VBA and Custom Forms 0
Nufc1980 Outlook "Please treat this as private label" auto added to some emails - Help. Using Outlook 3
K vba code to auto download email into a specific folder in local hard disk as and when any new email arrives in Inbox/subfolder Outlook VBA and Custom Forms 0
F Auto changing email subject line in bulk Using Outlook 2
T Outlook 2019 Not Using Auto Compete After Deletion of 365 Using Outlook 1
richardwing Auto forward email that is moves into a specific outlook folder Outlook VBA and Custom Forms 5
nmanikrishnan Auto-reply from default account Using Outlook 1
A Imap account not auto syncing inbox at startup Using Outlook 0
K Run a script rule to auto 'send again' on undeliverable emails? Outlook VBA and Custom Forms 1
FryW Need help modifying a VBA script for in coming emails to auto set custom reminder time Outlook VBA and Custom Forms 0
S Auto forward for multiple emails Outlook VBA and Custom Forms 0
DDB VBA to Auto Insert Date and Time in the signature Outlook VBA and Custom Forms 2
V Auto-complete stopped working Using Outlook 4
D auto forward base on email address in body email Outlook VBA and Custom Forms 0
M Replyall macro with template and auto insert receptens Outlook VBA and Custom Forms 1
R Auto Forwarding with different "From" Outlook VBA and Custom Forms 0
P auto-complete is hopelessly broken Using Outlook 0
R Auto Assign Category colours to Incoming Emails based on whom the email is addressed Outlook VBA and Custom Forms 3
C Auto Run VBA Code on new email Outlook VBA and Custom Forms 1
S Outlook Macro to send auto acknowledge mail only to new mails received to a specific shared inbox Outlook VBA and Custom Forms 0
V Auto-Submitted: auto-replied in header Using Outlook 0
R Auto display of new email does not work on non-default account Outlook VBA and Custom Forms 0
B Outlook 2016 Auto-archive creates new folder Using Outlook 3
J Edit auto-complete list in Outlook 2016+/365? Using Outlook 0
P Auto assign shared mailbox Outlook VBA and Custom Forms 1
M Outlook 2010 Problem with OutLook 2010 32 bit, after Windows Auto Update Using Outlook 3
Z Add text to auto-forwarded e-mail Outlook VBA and Custom Forms 4
N Disable Auto Read Receipts sent after using Advanced Find Using Outlook 4
Q Prompt button to auto turn on Out of Office Outlook VBA and Custom Forms 3
P Auto Insert Current Date or Time into Email Subject Outlook VBA and Custom Forms 2
S Messages moved / deleted by auto-archive are not synchronized to exchange Exchange Server Administration 8
B Outlook 2010 is Auto Purging when not configured for that Using Outlook 1
M VBA to auto forward message with new subject and body text Outlook VBA and Custom Forms 8
A Auto Accept Meetings from the General Calendar Using Outlook 3
R auto send email when meeting closes from a shared calendar only Outlook VBA and Custom Forms 2
S auto-mapping mailboxes in outlook impacting an ost file? Exchange Server Administration 2
M Auto expand Distribution List Before Sending Email Outlook VBA and Custom Forms 1
M Auto-export mail to Excel Outlook VBA and Custom Forms 2
Ms_Cynic Auto-pasting email content in calendar appt? Using Outlook 2
R How Do I insert images in and Auto Reply Using Outlook 3
S Received mail as part of DL, need to auto-CC the same when replying Outlook VBA and Custom Forms 5
T Have Outlook 2016 suggest email address auto complete entries directly from the user's contacts list Using Outlook 10
T Have Outlook 2016 suggest email address auto complete entries directly from the user's contacts list Using Outlook 0

Similar threads

Back
Top