How to Change the subject of emails on one folder depending on the sender

I've been requested to create a macro that will change the subject of a email  message depending on the sender.
the problem is that the user receives many emails regarding orders, the messages are place in a folder by a rule and I want to change the subject
i.e.
i receive a message from john@doe.com with the subject
"Status of Shipments 01/01/08"
I want to be able to change the subject to read:
"ONTARIO - Status of Shipments 01/01/08"

My Idea is to be able to select a number of emails on the personal folder file
lets say the name of the folder is "IBA"

So the logic for this macro is
for all messages selected in folder "IBA" if the sender is John@Doe.com then
take the subject and add at the begining of the subject "ONTARIO - "
if the sender is Jane@doe.com then then take the subject
and add at the begining of the subject "VERNON - " 
LVL 10
TOPIOAsked:
Who is Participating?
 
David LeeCommented:
Hi, TOPIO.

This should do it.  I haven't tested it though.
Sub FixSubject()
    Dim olkMsg As Outlook.MailItem
    For Each olkMsg In Application.ActiveExplorer.Selection
        Select Case olkMsg.SenderEmailAddress
            'Create a Case statement like one of these for each possible address
            'The address must be an exact match including case
            Case "John@Doe.com"
                olkMsg.Subject = "ONTARIO - " & olkMsg.Subject
            Case "Jane@Doe.com"
                olkMsg.Subject = "VERNON - " & olkMsg.Subject
        End Select
        olkMsg.Save
    Next
    Set olkMsg = Nothing
    MsgBox "All done!"
End Sub

Open in new window

0
 
TOPIOAuthor Commented:
I get the following error:

Select Case olkMsg.SenderEmailAddress <<<<Object Does not Support this property or method
0
 
TOPIOAuthor Commented:
I corrected the previous error by changing
strOriginAddress = olkMsg.SenderName

however when I run the macro on meeting requests I get the following error

For Each olkMsg In Application.ActiveExplorer.Selection <<< Run time error '13' Type Mismatch
0
Cloud Class® Course: Amazon Web Services - Basic

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

 
David LeeCommented:
Apologies for the first error.  I didn't know what version of Outlook you're using.

The second error would occur if something other than a mail message was selected.  Either insure that all the items you've selected are mail items, or change this line

    Dim olkMsg As Outlook.MailItem

to

    Dim olkMsg As Object
0
 
TOPIOAuthor Commented:
THANKS!
FINAL VERSION  IS BELOW

Sub FixSubjectForIBAMails()
    Dim olkMsg As Object
    Dim strOriginAddress As String
    
    For Each olkMsg In Application.ActiveExplorer.Selection
    
    strOriginAddress = olkMsg.SenderName
                      
                        
  '  MsgBox strOriginAddress
        Select Case strOriginAddress
            'Create a Case statement like one of these for each possible address
            'The address must be an exact match including case
            Case "Garcia, Carmen"
                olkMsg.Subject = "VERNON - " & olkMsg.Subject
            Case "Ibarra, David"
                olkMsg.Subject = "VERNON - " & olkMsg.Subject
            Case "Olmos, Claudia"
                olkMsg.Subject = "VERNON - " & olkMsg.Subject
            Case "Pedroza, Norma"
                olkMsg.Subject = "ONTARIO - " & olkMsg.Subject
             Case "Vega, Vanessa"
                olkMsg.Subject = "VERNON - " & olkMsg.Subject
                
                
        End Select
        olkMsg.Save
    Next
    Set olkMsg = Nothing
    MsgBox "All done!"
End Sub

Open in new window

0
 
David LeeCommented:
You're welcome.  Glad I could help out.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.