Home > database >  Outlook Rules using VBA
Outlook Rules using VBA

Time:10-05

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
  • Related