Kind of a long title, so I'll try to explain here.
The code is to run based off the currently selected emails in a folder. The code works fine, but I would like to add a few small changes that would greatly improve my productivity. The code looks through my selected item's subject for a key word using InStr and then will forward the email to myDesiredRecipient should the keyword be found. The code also does the same thing for the body of the email. I would like to add a portion to the code that would check three other criteria before forwarding the email to myDesiredRecipient.
The three criteria I would like it to check are:
1. SenderEmailAddress -- There is a nice property for this, I think a simple "If SenderEmailAddress = "myDesiredSender" Then" would work.
2. RecipientEmailAddress -- I could not find a simple way to check the recipients of my current selection.
3. CCEmailAddress -- Same as Recipients, but for those emails listed as CC'd.
Below is the original code that is 100% working. Beneath this section of code, I will add the essence of the code that I wish to create (not working).
Working:
Sub ForwardEmails()
Dim outlookApp
Dim myTasks As Object
Dim outMail As MailItem
Set outlookApp = CreateObject("Outlook.Application")
Set myTasks = outlookApp.ActiveExplorer.Selection
For i = myTasks.Count To 1 Step -1
If TypeOf myTasks(i) Is MailItem Then
If (InStr(1, myTasks(i).Subject, "NameOne", vbTextCompare) > 0) Or (InStr(1, myTasks(i).Subject, "NameTwo", vbTextCompare) > 0) Then
myTasks(i).Categories = "Actioned"
myTasks(i).Save
Set outMail = myTasks(i).Forward
outMail.Display
outMail.Recipients.Add "myDesiredRecipient@test.com"
ElseIf (InStr(1, myTasks(i).body, "NameOne", vbTextCompare) > 0) Or (InStr(1, myTasks(i).body, "NameTwo", vbTextCompare) > 0) Then
myTasks(i).Categories = "Actioned"
myTasks(i).Save
Set outMail = myTasks(i).Forward
outMail.Display
outMail.Recipients.Add "myDesiredRecipient@test.com"
End If
End If
Next
End Sub
The below code should look for the keyword in the subject AND check for myDesiredRecipient's email address in the TO, From, and CC. If both are True, the email is marked as actioned. If only the keyword is found, the email will be forwarded to myDesiredRecipient. The same block of code will repeat for the body.
Not Working
Sub ForwardEmails()
Dim outlookApp
Dim myTasks As Object
Dim outMail As MailItem
Set outlookApp = CreateObject("Outlook.Application")
Set myTasks = outlookApp.ActiveExplorer.Selection
For i = myTasks.Count To 1 Step -1
If TypeOf myTasks(i) Is MailItem Then
If (InStr(1, myTasks(i).Subject, "NameOne", vbTextCompare) > 0) Or (InStr(1, myTasks(i).Subject, "NameTwo", vbTextCompare) > 0) and myTasks(i).SenderEmailAddress = "myDesiredSender@test.com" and _
myTasks(i).RecipientEmailAddress = "myDesiredRecipient@test.com" and myTasks(i).CCEmailAddress = "myDesiredRecipient@test.com" Then
myTasks(i).Categories = "Actioned"
myTasks(i).Save
ElseIf (InStr(1, myTasks(i).subject, "NameOne", vbTextCompare) > 0) Or (InStr(1, myTasks(i).subject, "NameTwo", vbTextCompare) > 0) Then
myTasks(i).Categories = "Actioned"
myTasks(i).Save
Set outMail = myTasks(i).Forward
outMail.Display
outMail.Recipients.Add "myDesiredRecipient@test.com"
ElseIf (InStr(1, myTasks(i).body, "NameOne", vbTextCompare) > 0) Or (InStr(1, myTasks(i).body, "NameTwo", vbTextCompare) > 0) and myTasks(i).SenderEmailAddress = "myDesiredSender@test.com" and _
myTasks(i).RecipientEmailAddress = "myDesiredRecipient@test.com" and myTasks(i).CCEmailAddress = "myDesiredRecipient@test.com" Then
myTasks(i).Categories = "Actioned"
myTasks(i).Save
ElseIf (InStr(1, myTasks(i).body, "NameOne", vbTextCompare) > 0) Or (InStr(1, myTasks(i).body, "NameTwo", vbTextCompare) > 0) Then
myTasks(i).Categories = "Actioned"
myTasks(i).Save
Set outMail = myTasks(i).Forward
outMail.Display
outMail.Recipients.Add "myDesiredRecipient@test.com"
End If
End If
Next
End Sub
Thank you for reading. Appreciate any help! Thanks
Bookmarks