Link to home
Start Free TrialLog in
Avatar of antonioking
antoniokingFlag 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

SOLUTION
Avatar of Joe Howard
Joe Howard
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of 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
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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

Thank you