Create/Copy (this rule on all accounts) outlook using vba

Question

Is there any way to copy outlook rule of one account to another account using vba code. I have researched on internet i have not found any thing related to my question, Pls help me. refer any link. I am not expert much of vba.I will be very thankful to you.

Answer 1

See Import or export a set of rules.

You can create rules programmatically. The Create method of the Rules class creates a Rule object with the name specified by Name and the type of rule specified by RuleType. The RuleType parameter of the added rule determines valid rule actions, rule conditions, and rule exception conditions that can be associated with the Rule object. When a rule is added to the collection, the Rule.ExecutionOrder of the new rule is 1. The ExecutionOrder of other rules in the collection is incremented by 1.

 Sub CreateRule() 
   Dim colRules As Outlook.Rules 
   Dim oRule As Outlook.Rule 
   Dim colRuleActions As Outlook.RuleActions 
   Dim oMoveRuleAction As Outlook.MoveOrCopyRuleAction 
   Dim oFromCondition As Outlook.ToOrFromRuleCondition 
   Dim oExceptSubject As Outlook.TextRuleCondition 
   Dim oInbox As Outlook.Folder 
   Dim oMoveTarget As Outlook.Folder 
   'Specify target folder for rule move action 
   Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox) 
   'Assume that target folder already exists 
   Set oMoveTarget = oInbox.Folders("Dan") 
   'Get Rules from Session.DefaultStore object 
   Set colRules = Application.Session.DefaultStore.GetRules() 
   'Create the rule by adding a Receive Rule to Rules collection 
   Set oRule = colRules.Create("Eugene's rule", olRuleReceive) 
   'Specify the condition in a ToOrFromRuleCondition object 
   'Condition is if the message is sent by "DanWilson" 
   Set oFromCondition = oRule.Conditions.From 
   With oFromCondition 
    .Enabled = True 
    .Recipients.Add ("Eugene Astafiev") 
    .Recipients.ResolveAll 
   End With 

   'Specify the action in a MoveOrCopyRuleAction object 
   'Action is to move the message to the target folder 
   Set oMoveRuleAction = oRule.Actions.MoveToFolder 
   With oMoveRuleAction 
    .Enabled = True 
    .Folder = oMoveTarget 
   End With 

   'Specify the exception condition for the subject in a TextRuleCondition object 
   'Exception condition is if the subject contains "fun" or "chat" 
   Set oExceptSubject = _ 
   oRule.Exceptions.Subject 
   With oExceptSubject 
    .Enabled = True 
    .Text = Array("fun", "chat") 
   End With 

   'Update the server and display progress dialog 
   colRules.Save 
 End Sub