Solved: Outlook : Delete an existing filtering rule using VBA

[vadius]

Hi all,

I created a macro to add a filtering rule in Outlook 2007.
Each day, this rule must be updated. Do you know how I can specifiy in the beginning of my macro to look for the existing rule, if found, delete it and then create the updated rule. Like a daily update of the rule if you prefer...

Thanks



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("Test")

'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("Test's rule", olRuleReceive)

'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 oConditionSubject = oRule.Conditions.Subject
With oConditionSubject
.Enabled = True
.Text = Array("bla", "gla")
End With

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

[dougbert]

Hi vadius,

If my solution works for you, please mark this thread as 'Solved' by using the Thread Tools menu just above your post to the right? A nice rating wouldn't hurt my feelings either. :rotlaugh:

See if this will work for you:



Option Explicit
Sub RemoveAndCreateRule()

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 oConditionSubject As Outlook.TextRuleCondition
Dim oInbox As Outlook.Folder
Dim oMoveTarget As Outlook.Folder
Dim i As Integer
Dim oRuleName As String
oRuleName = "Test's rule" 'Rule name is CaSe SenSitivE

'Get Rules from Session.DefaultStore object
Set colRules = Application.Session.DefaultStore.GetRules()

'Loop through all rules
For i = colRules.Count To 1 Step -1
'Look for oRuleName
If colRules.Item(i).Name = oRuleName Then
'If oRuleName found, remove oRuleName rule and save rules
colRules.Remove (oRuleName)
colRules.Save
GoTo Continue 'Once oRuleName found, removed and rules saved, jump to Continue
End If
Next

Continue:
'Specify target folder for rule move action
Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
'Assume that target folder already exists
Set oMoveTarget = oInbox.Folders("Test")

'Create the rule by adding a Receive Rule to Rules collection
Set oRule = colRules.Create("Test's rule", olRuleReceive)

'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 oConditionSubject = oRule.Conditions.Subject
With oConditionSubject
.Enabled = True
.Text = Array("bla", "gla")
End With
'Update the server and display progress dialog
colRules.Save
End Sub

[dougbert]

I hadn't spent enough time looking at the rest of your code unitl I realized you were bound to run out of memory pretty quickly, if left as is.

Use this code instead, which releases the memory before closing the sub:



Option Explicit
Sub RemoveAndCreateRule()

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 oConditionSubject As Outlook.TextRuleCondition
Dim oInbox As Outlook.Folder
Dim oMoveTarget As Outlook.Folder
Dim i As Integer
Dim oRuleName As String
oRuleName = "Test's rule" 'Rule name is CaSe SenSitivE

'Get Rules from Session.DefaultStore object
Set colRules = Application.Session.DefaultStore.GetRules()

'Loop through all rules
For i = colRules.Count To 1 Step -1
'Look for oRuleName
If colRules.Item(i).Name = oRuleName Then
'If oRuleName found, remove oRuleName rule and save rules
colRules.Remove (oRuleName)
colRules.Save
GoTo Continue 'Once oRuleName found, removed and rules saved, jump to Continue
End If
Next

Continue:
'Specify target folder for rule move action
Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
'Assume that target folder already exists
Set oMoveTarget = oInbox.Folders("Test")

'Create the rule by adding a Receive Rule to Rules collection
Set oRule = colRules.Create("Test's rule", olRuleReceive)

'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 oConditionSubject = oRule.Conditions.Subject
With oConditionSubject
.Enabled = True
.Text = Array("bla", "gla")
End With
'Update the server and display progress dialog
colRules.Save

Set colRules = Nothing
Set oInbox = Nothing
Set oMoveTarget = Nothing
Set oRule = Nothing
Set oMoveRuleAction = Nothing
Set oConditionSubject = Nothing
End Sub


I'm uncertain exactly how you will be utilizing this macro, but it does what you asked for it to do in your request. Do you intend to update the VBA rule code each day as well, in order to maintain it? Adding some input boxes would make that a lot easier. Additionally, this code 'fires' everytime a message comes in that meets the criteria. In other words, it will delete the existing rule, and replace it with your 'rule update', even if it's the same criteria.

Let me know if I can provide you with additional help.

-dougbert

[dougbert]

Strike that last thought about this macro 'firing' every time a new message arrives. I didn't think that through very well when I wrote that. :doh: Hey, it's the weekend and I don't get paid to think again until tomorrow.:rotlaugh:

[vadius]

Hello Mate,

Thank you so mych for your help on this. It does exactly what I wanted. What I need to do now is to populate the array with an excel spreadsheet. I tried to code something but it fails. Put it in another thread. Thanks you anyway!