[vba] Check outlook CC for domain & subject phrase

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

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.

Code:

---

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

---

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.

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/ru...-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.

Code:

---

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

---

Quote:

---

Originally Posted by gmayor

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"?

Code:

---

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

So like if it were an if statement it would be

Code:

---

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

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

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.

Code:

---

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

Code:

---

Set olFolder = Session.GetDefaultFolder(olFolderInbox).Folders("Vendor")

---

i.e. A direct sub folder of the default InBox. What is the path of the folder?

Quote:

---

Originally Posted by gmayor

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.

Quote:

---

Originally Posted by gmayor

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?

Code:

---

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

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

Code:

---

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

---

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

Code:

---

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

---

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/...eld-in-outlook

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

Code:

---

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

---

Quote:

---

Originally Posted by gmayor

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