Avatar of antonioking
antonioking
Flag for United Kingdom of Great Britain and Northern Ireland asked on

Create rule in Outlook using vb script

Please can I have some assitance modifying this script.
It currently Opens and creates a rule (if it doesn't already exist)
The rule moves all arriving emails from the user to the sent items folder except if the users name is in the to or cc box.

I'd like to add another exception
"except if sent to ..."

The address are all of our distribution group addresses.

Const RULE_NAME = "Move BCC msgs to myself to Sent Items"
Const olRuleReceive = 0
Const olFolderSentMail = 5
Dim olkApp, olkSes, olkCol, olkRul, olkCD1, olkCD2, olkMRA
On Error Resume Next
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkCol = olkSes.DefaultStore.GetRules()
Set olkRul = olkCol.Item(RULE_NAME)
Debug.Write TypeName(olkRul)
If Typename(olkRul) = "Empty" Then
    Set olkRul = olkCol.Create(RULE_NAME, olRuleReceive)
    Set olkCD1 = olkRul.Conditions.From
    With olkCD1
        .Enabled = True
        .Recipients.Add olkSes.CurrentUser.Address
        .Recipients.ResolveAll
    End With
    Set olkCD2 = olkRul.Exceptions.ToOrCc
    With olkCD2
        .Enabled = True
    End With
    Set olkMRA = olkRul.Actions.MoveToFolder
    With olkMRA
        .Enabled = True
        Set .Folder = olkSes.GetDefaultFolder(olFolderSentMail)
    End With
    olkCol.Save False
End If
olkSes.Logoff
olkApp.Quit
Set olkMRA = Nothing
Set olkCD2 = Nothing
Set olkCD1 = Nothing
Set olkRul = Nothing
Set olkCol = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
WScript.Quit

Open in new window

VB ScriptVisual Basic ClassicOutlook

Avatar of undefined
Last Comment
antonioking

8/22/2022 - Mon
SOLUTION
Joe Howard

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
antonioking

ASKER
That doesn't add an exception it just moves emails from those groups.

I want to add an exception to the rule that any email sent TO set addresses are excluded
ASKER CERTIFIED SOLUTION
antonioking

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
ltlbearand3

So you want to modify the rule to add a don't move if this email address is in the to field option?  If so add in this code:

        Dim olkCD3
        Set olkCD3 = olkRul.Exceptions.SentTo
        With olkCD3
            .Enabled = True
            .Recipients.Add "emailaddress@domain.com"   ' Put in the exception email here
        End With

Open in new window


Add that code right after:
        Set olkCD2 = olkRul.Exceptions.ToOrCc
        With olkCD2
            .Enabled = True
        End With

Open in new window

antonioking

ASKER
Thank you
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes