add a red flag to a email if the receiver's email is xxx.yahoo.com and yyy.yahoo.com

[uktous]

Hi,

Could you please write the following macro?


For each email in folder: inbox

If the receiver’s email is xxx.yahoo.com and yyy.yahoo.com, then the email will have a red flag.

Note: the email should be sent to both xxx.yahoo.com and yyy.yahoo.com, not either one of them.

Thanks

[mancubus]

hi.
i'm not an expert but googling and trial n error gave me this.
i tested and it worked for my sample emails...
i created a folder named "test", copied some emails there, only one meeting the criteria and used Set olFolder = olNS.PickFolder to select this folder.



Sub VBAX_Flag_OLMails_Based_Recipients_Email()
http://www.vbaexpress.com/forum/showthread.php?t=45174

Dim olApp As Outlook.Application
Dim olNS As NameSpace, olFolder As MAPIFolder
Dim objMail As Object, objRecip As Object
Dim arrRecip, FindMail1, FindMail2
Dim i As Long
Dim MatchCase As Boolean

MatchCase = False
FindMail1 = "xxx.yahoo.com"
FindMail2 = "yyy.yahoo.com"
C = Chr$(1)

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
'Set olFolder = olNS.PickFolder 'in order to pick the desired folder use this line.

For Each objMail In olFolder.Items
With objMail
If .Class = olMail Then
ReDim arrRecip(1 To .Recipients.Count)
For i = 1 To .Recipients.Count
arrRecip(i) = .Recipients(i)
Next
If InStr(1, C & Join(arrRecip, C) & C, C & FindMail1 & C, 1 + MatchCase) _
And _
InStr(1, C & Join(arrRecip, C) & C, C & FindMail2 & C, 1 + MatchCase) Then
'http://www.mrexcel.com/forum/excel-questions/63296-visual-basic-applications-function-search-array.html#post2766823
.FlagStatus = olFlagMarked
.FlagIcon = 6
.Save
End If
End If
End With
Next

End Sub