1. Here's a thread that needs an answer: I adore helping in all things to my friends
    Dismiss Notice

Edit Subject (Multiple Accounts)

Discussion in 'Outlook VBA and Custom Forms' started by dan1_uk, Dec 7, 2017.

Tags:
  1. dan1_uk

    dan1_uk

    New Member
    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?
     
  2. Diane Poremsky

    Diane Poremsky

    Senior Member
    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:
    Code (Text):
    Copy Source
    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
     
  3. dan1_uk

    dan1_uk

    New Member

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

    Cheers!
     
  4. dan1_uk

    dan1_uk

    New Member
    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:

    Code (Text):
    Copy Source
    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
     
  5. Diane Poremsky

    Diane Poremsky

    Senior Member
    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
     
Loading...

Share This Page