I am creating a CreateRule module for Outlook so that I can transfer set rules to other accounts in an instant. I used this code below to transfer set rules to folders in outlook, I am unable to set the "olConditionBodyOrSubject" condition to transfer email that contains specific words in subject or body;:
Option Explicit
Sub CreateRule()
Dim oRulesRes As Outlook.Rules
Dim oRuleRes As Outlook.Rule
Dim oRulesBod As Outlook.Rules
Dim oRuleBod As Outlook.Rule
Dim oRuleActions As Outlook.RuleActions
Dim oMoveRuleActionRes As Outlook.MoveOrCopyRuleAction
Dim oMoveRuleActionBod As Outlook.MoveOrCopyRuleAction
Dim oFromCondition As Outlook.ToOrFromRuleCondition
Dim oExceptSubject As Outlook.TextRuleCondition
Dim oInbox As Outlook.Folder
Dim oMoveTargetRes As Outlook.Folder
Dim oMoveTargetBod As Outlook.Folder
Dim olConditionBodyOrSubject As Outlook.TextRuleCondition
Dim oApp As Outlook.Application
Dim ws As Variant
Set oApp = GetObject("", "Outlook.Application")
Set oInbox = oApp.Session.GetDefaultFolder(olFolderInbox)
Set oMoveTargetRes = oInbox.Folders("Indeed")
Set oMoveTargetBod = oInbox.Folders("Concentrix")
Set oRulesRes = oApp.Session.DefaultStore.GetRules()
Set oRulesBod = oApp.Session.DefaultStore.GetRules()
Set oRuleRes = oRulesRes.Create("Recepient Rule", olRuleReceive)
Set oRuleBod = oRulesBod.Create("Body Rule", olRuleReceive)
Set oFromCondition = oRuleRes.Conditions.From
Set olConditionBodyOrSubject = oRuleBod.Conditions.BodyOrSubject
'Subject Condition must include
Set ws = ("Subject Condition")
With oFromCondition
.Enabled = True
.Recipients.Add ("[email protected]")
.Recipients.ResolveAll
End With
With olConditionBodyOrSubject
.Enabled = True
.Text = ws
End With
'Move res to folder
Set oMoveRuleActionRes = oRuleRes.Actions.MoveToFolder And oRuleBod.Actions.MoveToFolder
With oMoveRuleActionRes
.Enabled = True
.Folder = oMoveTargetRes
End With
'Move bod to folder
Set oMoveRuleActionBod = oRuleBod.Actions.MoveToFolder
With oMoveRuleActionBod
.Enabled = True
.Folder = oMoveTargetBod
End With
'Exception condition is if the subject contains
Set oExceptSubject = _
oRuleRes.Exceptions.Subject
With oExceptSubject
.Enabled = True
.Text = Array("click", "won")
End With
'Update the server and display progress dialog
oRulesRes.Save
oRulesBod.Save
'Execute rule
For Each oRuleRes In oRulesRes
oRuleRes.Execute
Next oRuleRes
For Each oRuleBod In oRulesBod
oRuleBod.Execute
Next oRuleBod
'CleanUp
If Not oRuleRes Is Nothing Then
Set oRuleRes = Nothing
End If
If Not oRulesRes Is Nothing Then
Set oRulesRes = Nothing
End If
If Not oRuleBod Is Nothing Then
Set oRuleBod = Nothing
End If
If Not oRulesBod Is Nothing Then
Set oRulesBod = Nothing
End If
If Not oExceptSubject Is Nothing Then
Set oExceptSubject = Nothing
End If
If Not oMoveRuleActionRes Is Nothing Then
Set oMoveRuleActionRes = Nothing
End If
If Not oMoveRuleActionBod Is Nothing Then
Set oMoveRuleActionBod = Nothing
End If
If Not oFromCondition Is Nothing Then
Set oFromCondition = Nothing
End If
If Not oMoveTargetRes Is Nothing Then
Set oMoveTargetRes = Nothing
End If
If Not oMoveTargetBod Is Nothing Then
Set oMoveTargetBod = Nothing
End If
If Not oApp Is Nothing Then
Set oApp = Nothing
End If
End Sub
CodePudding user response:
Try using the following code instead:
With olConditionBodyOrSubject
.Text = Array("Subject Condition")
.Enabled = True
End With