Consulting

Results 1 to 14 of 14

Thread: [vba] Check outlook CC for domain & subject phrase

  1. #1

    [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

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    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.

  4. #4
    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.

    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Quote Originally Posted by gmayor View Post
    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

  6. #6
    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

  7. #7
    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
    Last edited by Data Blake; 04-10-2020 at 12:12 PM.

  8. #8
    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?
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    Quote Originally Posted by gmayor View Post
    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 View Post
    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
    Last edited by Data Blake; 04-13-2020 at 07:59 AM.

  10. #10
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    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

  12. #12
    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
    Last edited by Data Blake; 04-13-2020 at 10:37 AM.

  13. #13
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  14. #14
    Quote Originally Posted by gmayor View Post
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •