[vba] Check outlook CC for domain & subject phrase

[Data Blake]

Hey all,


I'm trying to write a VBA script that, upon receiving an email, checks the CC for a list of emails or domains. As well if the subject contains the phrase "ST26". If any of the listed emails are in the CC i would like to move the email to a folder. I have to omit the dot coms and change the at signs to ampersand as per forum regulations.

It would be ideal if this could work using a domain rather than specific emails though, example being gmail instead of blake&gmail



so the list of emails to check
gmail
outlook
msn


if any of those 3 are found in the CC then move to a folder named "Vendor"


an example email CC that would trigger this rule:
carl&twitch; janice&vbaexpress; greg&msn

im not very familiar with Outlook VBA syntax, only Excel VBA

[gmayor]

Assuming Vendor is a sub folder of your default inbox, if I have understood the requirement correctly, the following script run from a rule on incoming messages should work.


Sub CheckAndMoveMail(olItem As MailItem)
Dim olFolder As Folder
If TypeName(olItem) = "MailItem" Then
With olItem
Select Case True
Case InStr(1, .CC, "gmail") > 0, _
InStr(1, .CC, "outlook") > 0, _
InStr(1, .CC, "msn") > 0, _
InStr(1, .Subject, "ST26") > 0
Set olFolder = Session.GetDefaultFolder(olFolderInbox).folders("Vendor")
olItem.Move olFolder
olItem.UnRead = True
Case Else
End Select
End With
End If
lbl_Exit:
Set olFolder = Nothing
Exit Sub
End Sub

[Data Blake]

This looks like its exactly the solution i need the only thing is it isn't popping up in macro list. is there something i need to do thats different than excel VBA? or perhaps this automatically runs after putting it into a standard module? I also don't see "CheckAndMoveMail" or olItem in rule conditions.

[gmayor]

The macro runs from a rule and should go in a standard module. It won't appear in the list of macros because of the argument in brackets (olItem As MailItem), but it should appear in the list of scripts using the script option in rules. If you don't have the script option see https://www.slipstick.com/outlook/rules/outlook-run-a-script-rules/

If you want to test the macro then you need to call it from another macro e.g. as follows. Select a suitable message and run the following macro.


Sub Test()
Dim olMsg As MailItem
On Error Resume Next
Select Case Outlook.Application.ActiveWindow.Class
Case olInspector
Set olMsg = ActiveInspector.currentItem
Case olExplorer
Set olMsg = Application.ActiveExplorer.Selection.Item(1)
End Select
CheckAndMoveMail olMsg
lbl_Exit:
Set olMsg = Nothing
Exit Sub
End Sub

[Data Blake]

T but it should appear in the list of scripts using the script option in rules.

Thank you i got it to run
Now is there a way to point the instr to both the cc and to? Also want to make sure i don't need all of the conditions to be true. ST26 has to be true and then at least one of the CC/TO conditions have to be true, but not all of them.

I can't seem to step through with F8 and its not catching some emails where the "gmail" is in the "TO" field.
and the "ST26" is not case sensitive ("St26, ST26, st26, sT26"). can i ucase the subject and compare it to "ST26"?



Sub CheckAndMoveMail(olItem As MailItem)
Dim olFolder As Folder
If TypeName(olItem) = "MailItem" Then
With olItem
Select Case True
Case InStr(1, .CC, "gmail com") > 0, _
InStr(1, .CC, "msn com") > 0, _
InStr(1, .CC, "outlook com") > 0, _
InStr(1, UCase(.Subject), "ST26") > 0
Set olFolder = Session.GetDefaultFolder(olFolderInbox).Folders("Vendor")
olItem.Move olFolder
olItem.UnRead = True
Case Else
End Select
End With
End If
lbl_Exit:
Set olFolder = Nothing
Exit Sub
End Sub


thanks again for the help

[Data Blake]

So like if it were an if statement it would be



If InStr(1, .CC, "msn com") > 0, _
Or InStr(1, .CC, "gmail com") > 0, _
Or InStr(1, .CC, "outlook com") > 0, _
And InStr(1, UCase(.Subject), "ST26") > 0 _
Then 'move the email


except CC and TO fields

[Data Blake]

i am also getting an error message on ones that it is catching.
"Run-time error '-2147352567 (80020009)":
Cannot move the items."

and highlighting the line

olItem.Move olFolder

[gmayor]

The macro uses case statements so if any of those statements is true, the test will be true. They don't all have to be true.

If you want to check the To field also then you will need to add the three checks e.g.


Case InStr(1, .CC, "gmail com") > 0, _
InStr(1, .CC, "msn com") > 0, _
InStr(1, .CC, "outlook com") > 0, _
InStr(1, .To, "gmail com") > 0, _
InStr(1, .To, "msn com") > 0, _
InStr(1, .To, "outlook com") > 0, _
InStr(1, UCase(.Subject), "ST26") > 0
Set olFolder = Session.GetDefaultFolder(olFolderInbox).folders("Vendor")
olItem.Move olFolder
olItem.UnRead = True


If the Move doesn't work then either the Vendor folder doesn't exist or it is not where the macro expects it to be. The macro looks at

Set olFolder = Session.GetDefaultFolder(olFolderInbox).Folders("Vendor")i.e. A direct sub folder of the default InBox. What is the path of the folder?

[Data Blake]

If the Move doesn't work then either the Vendor folder doesn't exist or it is not where the macro expects it to be. What is the path of the folder?

it is a subfolder of the inbox. I will try the macro again and see if it still occurs.


The macro uses case statements so if any of those statements is true, the test will be true.
So if it detects "gmail com" in the cc but does NOT contain ST26 in the subject line it will still move the email? I'm more looking to combine those two things as true

Must be true:
1. The subject contains ST26
2. One or more of the 3 email options (gmail, msn, outlook) is in the To or CC fields

so would this work?



Sub CheckAndMoveMail(olItem As MailItem)
Dim olFolder As Folder
Dim x As Long

If TypeName(olItem) = "MailItem" Then
With olItem

Select Case True
Case InStr(1, .CC, "gmail com") > 0
x = 1
Case InStr(1, .CC, "msn com") > 0
x = 1
Case InStr(1, .CC, "outlook com") > 0
x = 1
Case InStr(1, .To, "gmail com") > 0
x = 1
Case InStr(1, .To, "msn com") > 0
x = 1
Case InStr(1, .To, "outlook com") > 0
x = 1
Case InStr(1, UCase(.Subject), "ST26") > 0
x = x + 1
End Select

If x = 2 Then
Set olFolder = Session.GetDefaultFolder(olFolderInbox).Folders("Vendor")
olItem.Move olFolder
olItem.UnRead = True
End If
End With
End If
lbl_Exit:
Set olFolder = Nothing
Exit Sub
End Sub



that way if any of the emails are found x = 1 and then if ST26 is found x = 2 but if ST26 isnt found x = 1 or x = 0 would not move the mail

[gmayor]

In that case move the subject test out of the case statement e.g.


With olItem
If InStr(1, UCase(.Subject), "ST26") > 0 Then
Select Case True
Case InStr(1, .CC, "gmail com") > 0, _
InStr(1, .CC, "msn com") > 0, _
InStr(1, .CC, "outlook com") > 0, _
InStr(1, .To, "gmail com") > 0, _
InStr(1, .To, "msn com") > 0, _
InStr(1, .To, "outlook com") > 0
Set olFolder = Session.GetDefaultFolder(olFolderInbox).folders("Vendor")
olItem.Move olFolder
olItem.UnRead = True
Case Else
End Select
End If
End With

[Data Blake]

now if i run this rule should it move eligible emails? or are scripts special and do nut apply to run...?
Here is what i have



Sub CheckAndMoveMail(olItem As MailItem)
Dim olFolder As Folder

If TypeName(olItem) = "MailItem" Then
With olItem
If InStr(1, UCase(.Subject), "ST26") > 0 Then
Select Case True
Case InStr(1, .CC, "gmail com") > 0, _
InStr(1, .CC, "msn com") > 0, _
InStr(1, .CC, "outlook com") > 0, _
InStr(1, .To, "gmail com") > 0, _
InStr(1, .To, "msn com") > 0, _
InStr(1, .To, "outlook com") > 0
Set olFolder = Session.GetDefaultFolder(olFolderInbox).Folders("Vendors")
olItem.Move olFolder
olItem.UnRead = True
Case Else
End Select
End If
End With
End If
lbl_Exit:
Set olFolder = Nothing
Exit Sub
End Sub

[Data Blake]

using the test method above it looks like it isn't catching the CC or To because it is using their fullname and not the email address. I.E:

Danny Daniels
DannyATmsnDOTcom

it is sending "Danny Daniels" to the case checker and not DannyATmsnDOTcom
any way to insure the latter is used instead?

edit:
i found this but i don't know how to incorporate the recipient to what we currently have.
https://stackoverflow.com/questions/12641704/how-do-you-extract-email-addresses-from-the-to-field-in-outlook

[gmayor]

Basically you would use the SMTP address instead of .CC e,g,


Sub CheckAndMoveMail(olItem As MailItem)
Dim olFolder As Folder
Dim olRecipient As Recipient
Dim olPa As propertyAccessor
Dim strAddr As String
Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

If TypeName(olItem) = "MailItem" Then
With olItem
If InStr(1, UCase(.Subject), "ST26") > 0 Then
For Each olRecipient In .Recipients
If olRecipient.Type = olCC Then
Set olPa = olRecipient.propertyAccessor
strAddr = olPa.GetProperty(PR_SMTP_ADDRESS)
Select Case True
Case InStr(1, strAddr, "gmail com") > 0, _
InStr(1, strAddr, "msn com") > 0, _
InStr(1, strAddr, "outlook com") > 0, _
InStr(1, strAddr, "gmail com") > 0, _
InStr(1, strAddr, "msn com") > 0, _
InStr(1, strAddr, "outlook com") > 0
Set olFolder = Session.GetDefaultFolder(olFolderInbox).folders("Vendors")
olItem.Move olFolder
olItem.UnRead = True
Exit For
Case Else
End Select
End If
Next olRecipient
End If
End With
End If
lbl_Exit:
Set olFolder = Nothing
Set olPa = nothingh
Set olRecipient = Nothing
Exit Sub
End Sub

[Data Blake]

Basically you would use the SMTP address instead of .CC e,g,


AWESOME
i removed the "if recipient = cc" statement and this works perfectly as intended. thank you