Change Subject on incoming email.

hi cvmcadmin,

If understood this right, your trying to find out how much is sent to each address for future removal of the old one, right?
I think you can do this with Outlook rules. Just setup so that all incoming mail that is sent to the old address are redirected to a separate folder (ex. subfolder) or maybe flagged and have the server reply with a specific message that informs about the new one. Then you get an estimate which that uses the old and they are at the same time informed to use the new address.
If I understood you wrong, please explain more

I tried this; the problem is that because the clients outlook is pointing to the same server that both email address are on. And therefore Outlook can't distinguish what the address was used. I can do if I look at the message header.

Not sure I follow.  A rule can be established that checks incoming mail addresses and 'sorts' the old address items to a new foder.  Are you saying that when the mails arrive from the server that they all bear the new email addy as the sender email address?

Chris

All I want to do is Change the Subject in a NEW Email to say (Oldemailused) if it was sent to the old email address.

When a new email arrives thats using the old email addesss; I want to be able to change the Subject to Say OldEmaillused. So that the user can see very easy that there old email is still being used and therefore they can update the sender with the change of address.

Does this make sence? Sorry I wasn't explining myself very well :)

I understand what you are saying ... and as long as the sender email of the mail as it appears in the inbox has the old address visible then there are two options:

1. Move, (or copy) the emails to a special folder which is simple to see without modifying the subject.
2. Apply the prefix you want as part of a macro.

The rule copying the mail elsewere is much easier for you, but like I say a macro to make the edits CAN be created if you want but bothe are dependant on confirmation of the incoming mail sender address being displayed correctly.

Chris

I don't want to move the new email, just Change the Subject title.

This is a request from management, so I don't have any choice in the matter :)

IN thisOutlook session:

Insert the following sub.  If it already exists then you will need to merge the two.  I would have suggested a rule but I see you are using outlook 2000 and I don't think they support scripts.

Replace in the code fred@fred.com with the correct email for the old addy.

Chris

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim strEntryID() As String
Dim testObj As Object
Dim intFinal As Integer
 
    strEntryID = Split(EntryIDCollection & ",", ",")
    For intFinal = 0 To UBound(strEntryID) - 1
        Set testObj = Application.Session.GetItemFromID(strEntryID(intFinal))
        If testObj.Class = olMail Then
            Set mai = testObj
            If mai.SenderEmailAddress = "fred@fred.com"
                mai.Subject = "OldDomain: " & mai.Subject
                mai.Save
            End If
        End If
    Next
End Sub

Select allOpen in new window

I hate to sound dumb, but were do I put this within Outlook? running Outlook XP and 2003

Thanks!

Oh bother!

Your original post said outlook 2000.  The better answer then is to create a rulewhich runs off every received mail and select the script option.

To achieve this first in teh outlook VBE, press alt + F11 : insert module.  You will now have a module in the project explorer, (ctrl + R if it isn't visible).  Double click the modle and paste the snippet.

Tools | rules and alerts | new rule when messages arrive.  Under select actions choose run a script and select the oldMailSubjectPrefix sub you entred previously.  Note the first selection for conditions is passed over and yes you do want to apply it to every email.

Chris

Sub oldMailSubjectPrefix(mai As mailitem)
    If mai.SenderEmailAddress = "fred@fred.net" Then
        mai.Subject = "OldDomain " & mai.Subject
        mai.Save
    End If
End Sub

Select allOpen in new window

Sorry Chris, I will give that ago and let you know!

Thanks

I do the alt-F11 and do I paste it into the module1 area. then do I just close the VBA editor?

Cuz when I create the rule it doesn't show up. There nothing to pick from

This is Outlook 2003..just testing on my PC first

Are macros enabled ...also if it is to be deployed onto outlook 2000 the previou solution is required so there may be no point in testing it in this particular form as such!

Chris

Chris we have a mix of Outlook's. XP, 2000 and 2003.

Well I am not quite sure what I am doing wrong. If I open the VB editior (Alt+F11) and then paste the code in and save it, nothing apears in the macros list (Alt+F8). But if I got to create a new macro. put a name in and select Create. The VB editor pops up and and I paste the code in between the new sub and then close the editor. The Marco now shows up, but if I goto run it it errors.

If I just open the VBA editor and paste the code in for Oulook 2003

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim strEntryID() As String
Dim testObj As Object
Dim intFinal As Integer
 
    strEntryID = Split(EntryIDCollection & ",", ",")
    For intFinal = 0 To UBound(strEntryID) - 1
        Set testObj = Application.Session.GetItemFromID(strEntryID(intFinal))
        If testObj.Class = olMail Then
            Set mai = testObj
            If mai.SenderEmailAddress = "fred@fred.com"
                mai.Subject = "OldDomain: " & mai.Subject
                mai.Save
            End If
        End If
    Next
End Sub

Its never shows up as a macro or script.

I can't see what I am doing wrong.

Excuse me if I seem to be missing the issue but i'll try and explain.

1. Outlook 2003 supports rules running scripts whereas outlook 2000 does not.
2. To get a common approch it seems best to concentrate on the one solution.

Therefore you do NOT need module1.

You do need to put a code sequence in the thisoutlooksession module.  Best answer to ensure correct calling is I feel to paste the code in the auto routine.

In thisoutlooksession select application and newmailex.  Paste everything in the supplied newqmailex sub into this skeleton i.e:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

End Sub

and paste the code from the snippet mdifying the email addy as appropriate.

The code wil auto run when a mail comes in and should paste the required prefix without any more ado.  Note RULES are NOT required in this approach.

Chris

Dim strEntryID() As String
Dim testObj As Object
Dim intFinal As Integer
 
    strEntryID = Split(EntryIDCollection & ",", ",")
    For intFinal = 0 To UBound(strEntryID) - 1
        Set testObj = Application.Session.GetItemFromID(strEntryID(intFinal))
        If testObj.Class = olMail Then
            Set mai = testObj
            If mai.SenderEmailAddress = "fred@fred.com"
                mai.Subject = "OldDomain: " & mai.Subject
                mai.Save
            End If
        End If
    Next

Select allOpen in new window

Hi Chris, this code is working, apart from its based on the sender address.

I have now 2 email address.
me@myoldemail.com
me@mynewaddress.com

I want to change the subject when someone sends a email to my old email address. i.e. me@myoldemail.com

does this make sense? Sorry I should have made my self more clear :)

No you were perfectly clear it was a simple error on my part replace:

If mai.SenderEmailAddress = "fred@fred.com"
with
If mai.to = "me@myoldemail.com"

Doesn't seem to work. I just looked in the message header and I wonder if it is possible to say if it comes from this "Server" or "IP" then put in the "OLD Domain" message.

Just a thought. Thanks for all your help on this matter Chris.

Karl

It is possible from my recollection.  First a question though.  Can you supply rrepresentative data from an email showing the value of senderemailaddress to see why it should be failing the now.

As for the alternative, I have done some processing on the header in the past but will have to refresh myself as to how to use.  Again for this can you supply representative data of the header where the sender is presented.

Given the scope of extra work I would prefer to resolve the current approach ... and I want to know why it is failing at the moment as well as I don't understand ... and I want to understand!

Chris

The following snippet adds a single line to print out the to addresses to the VBE immediate window, (ctrl + G to toggle display).  Censor and obfuscate the data as necessary but supply representative information for analysis ... all formatting etc.

Chris

Sub cbReceive(ByVal EntryIDCollection As String)
Dim strEntryID() As String
Dim testObj As Object
Dim intFinal As Integer
 
    strEntryID = Split(EntryIDCollection & ",", ",")
    For intFinal = 0 To UBound(strEntryID) - 1
        Set testObj = application.Session.GetItemFromID(strEntryID(intFinal))
        If testObj.Class = olMail Then
            Set mai = testObj
            Debug.Print mai.To
            If mai.To = "me@myoldemail.com" Then
                mai.Subject = "OldDomain " & mai.Subject
                mai.Save
            End If
        End If
    Next
End Sub

Select allOpen in new window

Is this right? because when a email is sent to either address nothing pops up.

I'm sure I am doing something wrong. See file Attached
Outlook.JPG

Sorry .. because I do a lot of this type I use an indirect approach ... and forgot to correct the sub header
Replace:
Sub cbReceive(ByVal EntryIDCollection As String)
with
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

... or whatever your interface uses as mentioned before.  i.e. paste this to replace the body of the Application_NewMailEx subroutine you were using earlier

Chris

Okay when I sent a email to the old email my Display name showed up in that box i.e. Karl Lamdin

I guess this is because of the way exchange delivers the mail to the mailbox?!?

Indeed ... I need to think about this a bit ... I think I can get to the mail address but need to drag through some history.

Chris

Just a thought, but is there a way that we could set it so that if It comes from A then put the message in? or if the last part of the email adress is whatsever@olddomain.com then put the message in. Otherwise I have to touch everybody email address. This is an after thought sorry!!

Not clear to me but I understand you may want to select the change off either explicit mail addresses and/or domains ... amd if so then once the resilve issue is sorted the answer is yes.

Chris

okay

if the email is sent to *.*@newdomain.com = ignore
if the email is sent to *.*@olddomain.com = Add Message to the Subject

I would like to apply the script to eveyone without having to put in there old email address. So if the old domain is being used regarless of there name then add the text to the subject.

I don't explain myself to well do I ! :)

Well enough ... I understand the request.

It looks as though the easiest solution is to use redemption, (http://www.dimastr.com/redemption/) is this viable for you ... i.e. can you purchase and will IT support it's use?  If not i'll keep looking.

Chris

I hate to say it, but this is a cheap IS department. I took me near 6 weeks just to get the money for the subscription to experts-exchange.

If this is becoming to much hassle I totally undertsand. Just say you have done more than enough.

But if you manage to create a script I will send it to everyone via email with directions on how to install it.

Leave it open a whiles i'll try and find a solution ... have to justify all that expense :o)

Chris

Thanks Chris I appricate your help in this, I have another question open asking the same thing but on the exchange server. No answers also. I will award you the 500 points from there aswell once this is sorted.

Karl

Can you provide a real example from the output in the immediate window... replacing name with Mickey mouse for instance but keeping all structure as on a test I would expect something like:

/O=aaaaa/OU=bbbbb/CN=mailid

Chris

I think I have a potential solution which involves cycling around all recipients ... is there only the one recipient from the domain in these emails?

Chris

The output of the screen is nothing like /0aaaa/OU=bbbb.....

Its just my Display name from Exchange

i.e. Mickey.R.Mouse.

My last post will hopefully over-ride this ... it involves cycling around all the recipients, therefore the solution is either:

Only you as the recipient ... check your email domain
You as one of the recipients ... check each recipient for one of your domains.

I have done a test on a different system with exchange and it seems to work fine so I am reasonbly confident we will have an answer once I know how to handle recipients.

Chris

Chris, Sorry I am abit confused now. What would you like me to do?

Is there code  that I should be entering?

Are you the only recipient n these emails?

Chris

no, its  company wide. Everyone is being moved over to the new domain name

Yes sorry, I understood that but I think that answers my particular question as well.  You want an installation that applies to everyone and everyone needs to know if they have been addressed at the old domain.

I think a method to differentiate for the particular mailbox is a bit too much.  If you will be happy with setting the mark if ANY address in the email represents the old domain then I will go ahead and try to draft a change to do so.

Is that acceptable?

Chris

Yes go ahead with marking Any address that too the old doamin.

Place the following code snippet into a normal code module.

Chris

Function GetSMTPAddress(ByVal strAddress As String)
' As supplied by Vikas Verma ... see
' http://blogs.msdn.com/vikas/archive/2007/10/24/oom-getting-primary-smtp-address-from-x400-x500-sip-ccmail-etc.aspx
Dim oCon As ContactItem
Dim strKey As String
Dim oRec As Recipient
Dim strRet As String
Dim fldr As MAPIFolder
    'IF OUTLOOK VERSION IS >= 2007 THEN USES NATIVE OOM PROPERTIES AND METHODS
    On Error Resume Next
    Set fldr = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.item("Random")
    If fldr Is Nothing Then
        Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.Add "Random"
        Set fldr = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Folders.item("Random")
    End If
    On Error GoTo 0
    If CInt(Left(Application.Version, 2)) >= 12 Then
        Set oRec = Session.CreateRecipient(strAddress)
        If oRec.Resolve Then
            strRet = oRec.AddressEntry.GetExchangeUser.PrimarySmtpAddress
        End If
    End If
    If Not strRet = "" Then GoTo ReturnValue
    'IF OUTLOOK VERSION IS < 2007 THEN USES LITTLE HACK
    'How it works
    '============
    '1) It will create a new contact item
    '2) Set it's email address to the value passed by you, it could be X500,X400 or any type of email address stored in the AD
    '3) We will assign a random key to this contact item and save it in its Fullname to search it later
    '4) Next we will save it to local contacts folder
    '5) Outlook will try to resolve the email address & make AD call if required else take the Primary SMTP address from its cache and append it to Display name
    '6) The display name will be something like this " ( email.address@server.com )"
    '7) Now we need to parse the Display name and delete the contact from contacts folder
    '8) Once the contact is deleted it will go to Deleted Items folder, after searching the contact using the unique random key generated in step 3
    '9) We then need to delete it from Deleted Items folder as well, to clean all the traces
    Set oCon = fldr.Items.Add(olContactItem)
    oCon.Email1Address = strAddress
    strKey = "_" & Replace(Rnd * 100000 & Format(Now, "DDMMYYYYHmmss"), ".", "")
    oCon.FullName = strKey
    oCon.Save
    strRet = Trim(Replace(Replace(Replace(oCon.Email1DisplayName, "(", ""), ")", ""), strKey, ""))
    oCon.Delete
    Set oCon = Nothing
    Set oCon = Session.GetDefaultFolder(olFolderDeletedItems).Items.Find("[Subject]=" & strKey)
    If Not oCon Is Nothing Then oCon.Delete
ReturnValue:
    GetSMTPAddress = strRet
End Function

Select allOpen in new window

Place the following snippet in thisoutlooksession as the ONLY newmailexsub and set the constant OopsDomain  to your old domain.

I have tested this in my own area and as long as there is no conmtact, (for the recipient) in the contacts folder for the name then it seems to work fine.

Let me know how it goes of course.

Chris

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Const OopsDomain = "@olddomain.com"
Dim strEntryID() As String
Dim intFinal As Integer
Dim testObj As Object
Dim mai As mailitem
Dim emailAddress As String
Dim recip As Integer
Dim updateSubject As Boolean
Dim checkdomain As String
    
    strEntryID = Split(EntryIDCollection & ",", ",")
    checkdomain = OopsDomain
    If Left(checkdomain, 1) <> "@" Then checkdomain = "@" & checkdomain
    updateSubject = False
    For intFinal = 0 To UBound(strEntryID) - 1
        Set testObj = Application.Session.GetItemFromID(strEntryID(intFinal))
        If testObj.Class = olMail Then
            Set mai = testObj
            For recip = 1 To mai.Recipients.Count
                emailAddress = GetSMTPAddress(mai.Recipients(recip).Name)
                If Right(Replace(emailAddress, "'", ""), Len(checkdomain)) = checkdomain Then updateSubject = True
            Next
        End If
        If updateSubject Then
            mai.Subject = "Old Domain : " & mai.Subject
            mai.Save
        End If
    Next
 
End Sub

Select allOpen in new window

Is this correct? I have left the old domain name in there aswell so that you can see if I am doing it right or not.

Module.JPG
This-Session.JPG

Looks about right.  Is there a problem ... if so are macros enabled in outlook?

Tools Macro Security  set to medium for instance

Chris

Could you email me directly. I just want to send you something that i don't need the world to see.

karl.r.newick@hitchcock.org

OK, I think I see what could be happening, the code is case sensitive at the moment so replace:

newmailex as below:

Chris

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Const OopsDomain = "@olddomain.com"
Dim strEntryID() As String
Dim intFinal As Integer
Dim testObj As Object
Dim mai As mailitem
Dim emailAddress As String
Dim recip As Integer
Dim updateSubject As Boolean
Dim checkdomain As String
    
    strEntryID = Split(EntryIDCollection & ",", ",")
    checkdomain = lcase(OopsDomain)
    If Left(checkdomain, 1) <> "@" Then checkdomain = "@" & checkdomain
    updateSubject = False
    For intFinal = 0 To UBound(strEntryID) - 1
        Set testObj = Application.Session.GetItemFromID(strEntryID(intFinal))
        If testObj.Class = olMail Then
            Set mai = testObj
            For recip = 1 To mai.Recipients.Count
                emailAddress = GetSMTPAddress(mai.Recipients(recip).Name)
                If lcase(Right(Replace(emailAddress, "'", ""), Len(checkdomain))) = checkdomain Then updateSubject = True
            Next
        End If
        If updateSubject Then
            mai.Subject = "Old Domain : " & mai.Subject
            mai.Save
        End If
    Next
 
End Sub

Select allOpen in new window

Apologies I do not have access to server for now so can you try the following to gather data for both the old and the new domain.

Chris

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Const OopsDomain = "@olddomain.com"
Dim strEntryID() As String
Dim intFinal As Integer
Dim testObj As Object
Dim mai As mailitem
Dim emailAddress As String
Dim recip As Integer
Dim updateSubject As Boolean
Dim checkdomain As String
    
    strEntryID = Split(EntryIDCollection & ",", ",")
    checkdomain = lcase(OopsDomain)
    If Left(checkdomain, 1) <> "@" Then checkdomain = "@" & checkdomain
    updateSubject = False
    For intFinal = 0 To UBound(strEntryID) - 1
        Set testObj = Application.Session.GetItemFromID(strEntryID(intFinal))
        If testObj.Class = olMail Then
            Set mai = testObj
            For recip = 1 To mai.Recipients.Count
                debug.print mai.Recipients(recip).Name
                debug.print mai.Recipients(recip).address
            Next
        End If
        If updateSubject Then
            mai.Subject = "Old Domain : " & mai.Subject
            mai.Save
        End If
    Next
 
End Sub

Select allOpen in new window

Excellent Work! Thanks for al lyou help in this matter