使用VBA创建/复制(此规则适用于所有帐户)前景

时间:2018-06-23 07:02:49

标签: outlook outlook-vba outlook-2016

有什么方法可以使用vba代码将一个帐户的Outlook规则复制到另一个帐户。我在互联网上进行了研究,但未发现与我的问题有关的任何内容,请帮我。引用任何链接。我不是vba的专家,我会非常感谢您。

1 个答案:

答案 0 :(得分:0)

请参见Import or export a set of rules

您可以以编程方式创建规则。 Rules类的Create方法创建一个Rule对象,其名称由Name指定,规则类型由RuleType指定。添加的规则的RuleType参数确定可以与Rule对象关联的有效规则操作,规则条件和规则异常条件。将规则添加到集合后,新规则的Rule.ExecutionOrder为1。集合中其他规则的ExecutionOrder递增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