Edit Subject (Multiple Accounts)

[dan1_uk]

On my work PC I have two outlook accounts, my account and a shared account.

All external emails that we receive have an annoying note added to the subject line which is basically a warning that it's an external email.

I used to have a script set up with a rule but for some reason the 'run a script' option is no longer available under rules. I'm guessing it was an update but I have no admin rights on the machine.

I've now found some VBA code online that I used to remove this unwanted note from all emails as they arrive.
But unfortunately this only works for my email address, not the shared account.

The code I am using is:

Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
' instantiate objects declared WithEvents
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
Item.subject = Replace(Item.subject, "CAUTION: External email - ", "")
Item.Save
Set Item = Nothing
End Sub

Any Ideas on how to make this work for both accounts?

 

[Diane Poremsky]

I used to have a script set up with a rule but for some reason the 'run a script' option is no longer available under rules. I'm guessing it was an update but I have no admin rights on the machine.

Yeah, a security update removed it, it can be restored using a reg key.
Run-a-Script Rules Missing in Outlook

if you cant use the reg edit (or convince the admin to), you can convert the script to 'itemadd - that watches the folder and run it on all new mail. It can watch any folder, but you need to tell it to watch the folder....

Duplicate these lines, changing the bolded part to a new object name.
Private WithEvents olInboxItems As Items
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items

Copy the full macro, changing the object name
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)

To reference the other mailbox, Set sharedInboxItems = ***.Items, see
Working with VBA and non-default Outlook Folders
if its in as an account, you need to use the getfolderpath function or if its a in as a shared mailbox (notl isted in account settings), you need the shared code.

Because the macros are really short, duplicating you won't save code, but if it were longer, you could share the code:

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
RemoveWarning item
end sub

Private Sub sharedInboxItems_ItemAdd(ByVal Item As Object)
RemoveWarning item
end sub

Private Sub RemoveWarning(ByVal Item As Object)
On Error Resume Next
Item.subject = Replace(Item.subject, "CAUTION: External email - ", "")
Item.Save
Set Item = Nothing
End Sub

 

[dan1_uk]

Yeah, a security update removed it, it can be restored using a reg key.
Run-a-Script Rules Missing in Outlook

if you cant use the reg edit (or convince the admin to), you can convert the script to 'itemadd - that watches the folder and run it on all new mail. It can watch any folder, but you need to tell it to watch the folder....

Duplicate these lines, changing the bolded part to a new object name.
Private WithEvents olInboxItems As Items
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items

Copy the full macro, changing the object name
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)

To reference the other mailbox, Set sharedInboxItems = ***.Items, see
Working with VBA and non-default Outlook Folders
if its in as an account, you need to use the getfolderpath function or if its a in as a shared mailbox (notl isted in account settings), you need the shared code.

Because the macros are really short, duplicating you won't save code, but if it were longer, you could share the code:

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
RemoveWarning item
end sub

Private Sub sharedInboxItems_ItemAdd(ByVal Item As Object)
RemoveWarning item
end sub

Private Sub RemoveWarning(ByVal Item As Object)
On Error Resume Next
Item.subject = Replace(Item.subject, "CAUTION: External email - ", "")
Item.Save
Set Item = Nothing
End Sub

Yeah, a security update removed it, it can be restored using a reg key.
Run-a-Script Rules Missing in Outlook

if you cant use the reg edit (or convince the admin to), you can convert the script to 'itemadd - that watches the folder and run it on all new mail. It can watch any folder, but you need to tell it to watch the folder....

Duplicate these lines, changing the bolded part to a new object name.
Private WithEvents olInboxItems As Items
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items

Copy the full macro, changing the object name
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)

To reference the other mailbox, Set sharedInboxItems = ***.Items, see
Working with VBA and non-default Outlook Folders
if its in as an account, you need to use the getfolderpath function or if its a in as a shared mailbox (notl isted in account settings), you need the shared code.

Because the macros are really short, duplicating you won't save code, but if it were longer, you could share the code:

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
RemoveWarning item
end sub

Private Sub sharedInboxItems_ItemAdd(ByVal Item As Object)
RemoveWarning item
end sub

Private Sub RemoveWarning(ByVal Item As Object)
On Error Resume Next
Item.subject = Replace(Item.subject, "CAUTION: External email - ", "")
Item.Save
Set Item = Nothing
End Sub

Thanks for this, I’ll take a look at it when I’m back at work on Monday.

Cheers!

 

[dan1_uk]

I have now updated the code and can confirm it's working, thanks very much.
However I do have another issue.

I have a rule set up in Outlook to copy some emails from the shared account into a sub-folder in my account.
The rule is working but it copies the email before it has removed the unwanted text from the subject.

So the copied versions in my sub-folder still include the unwanted text.

Please see my code below:

Option Explicit

Private WithEvents olInboxItems As Items
Private WithEvents sharedInboxItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session

Dim NS As Outlook.NameSpace
Dim objOwner As Outlook.Recipient

Set NS = Application.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("xxxxxx@xxxxxx.com")
objOwner.Resolve

' instantiate objects declared WithEvents
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set sharedInboxItems = NS.GetSharedDefaultFolder(objOwner, olFolderInbox).Items
End Sub




Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
RemoveWarning Item
End Sub

Private Sub sharedInboxItems_ItemAdd(ByVal Item As Object)
RemoveWarning Item
End Sub

Private Sub RemoveWarning(ByVal Item As Object)
On Error Resume Next
Item.subject = Replace(Item.subject, "CAUTION: External email - ", "")
Item.Save
Set Item = Nothing
End Sub

Thanks

 

[Diane Poremsky]

Just one extra folder? You can watch that folder too.
Set olmysubfolderitems = objNS.GetDefaultFolder(olFolderInbox).folders("subbfolder").Items
(and all the other lines for olinboxitems)
However, if you have too many folders to watch, its unwieldy to watch each one.

Tip: if the folder is a subfolder of Inbox, use
dim olInbox as outlook.folder ' this may need to be up with the withevents lines

Set olInbox = objNS.GetDefaultFolder(olFolderInbox)
Set olInboxItems = olInbox.Items
Set olsubfolderItems = olInbox.Folders("subfolder").Items

 

[dan1_uk]

Thanks again, this has worked a treat!