Not sure if this is the right place to post this code but I didn't see a macro sharing category. @Mods Feel free to move where appropriate.
For outlook2010 exchange - no admin rights
I just wanted to give back a little to the VBA community and Mrs. Poremsky in particular. I have scavenged from everyone for the better part of a year and would like to give this in return (even if it's only for a particular few).
I know the issue with sorting rules and how it applies to the order in which rules run.
Those that can use this macro will find its usefulness as follows:
Without further adieu:
For outlook2010 exchange - no admin rights
I just wanted to give back a little to the VBA community and Mrs. Poremsky in particular. I have scavenged from everyone for the better part of a year and would like to give this in return (even if it's only for a particular few).
I know the issue with sorting rules and how it applies to the order in which rules run.
- 95% of my rules organize my inbox - sent from/to put in this folder
- I use stop processing rules- after the rule is run no more rules will run afterwards so the order doesn't effect the other rules
Those that can use this macro will find its usefulness as follows:
- Sort rules alphabetically [A-Z] (of sorts - see the comments in the macro for sort precedence)
- Sort rules to see if there is already a rule for a specific person
- Keep rules organized by the rule name - so multiple rules for a specific name will be grouped together
- Print out rules in debug window
- See how rules can be accessed through vba for more rules programming!
Without further adieu:
Code:
Sub SortRulesbyAlpha()
' Sort order ! " # $ % & ' ( ) * + , -
' . / 1 2 3 4 : ; < = > ? @
' A B C D ^ _ a b c d |
'
Dim Session As Outlook.NameSpace
Dim oRules As Outlook.rules
Dim oRule As Outlook.Rule
Dim varRule() As Variant
Dim srtTmp As Variant
Dim i As Long
Dim j As Variant
Set Session = Application.Session
Set oRules = Session.DefaultStore.GetRules()
On Error Resume Next
' Allocate space for array
ReDim varRule(oRules.Count - 1)
' Save rules to array: Sort by Name
i = 0
For Each oRule In oRules
Debug.Print oRule.Name & " : " & oRule.ExecutionOrder
varRule(i) = oRule.Name
i = i + 1
Next oRule
' Sort Rule Names A-Z
i = 0
For i = LBound(varRule) To UBound(varRule)
For j = i + 1 To UBound(varRule)
If varRule(i) > varRule(j) Then
srtTmp = varRule(j)
varRule(j) = varRule(i)
varRule(i) = srtTmp
End If
Next j
Next i
' Change Execution Order to Reflect Sort Order
i = 1
Debug.Print vbCrLf & vbCrLf & "After Sort"
For Each j In varRule
Debug.Print oRules.Item(j).Name & " : " & oRules.Item(j).ExecutionOrder
oRules.Item(j).ExecutionOrder = i
i = i + 1
Next j
'Save changes
oRules.Save
End Sub