Fix client mail rules
In forums discussing mail rules, a hot topic seems to be, "they just stopped working." This tips discusses how to fix this.
In forums discussing mail rules, a hot topic seems to be, "they just stopped working." There are a couple of reasons why this might have occurred, the primary being that the user deleted one or more enabled rule documents without disabling them first.
Mail rules are stored in two locations in a users' mail file:
- The mail rule document in the rules folder.
- The compiled mail rule formula stored in the calendar profile document.
It is this second compiled rule that the Domino ROUTER task uses prior to delivering mail. It is this second compiled rule that is left in the calendar profile which never gets deleted –- ergo the 'rules just stopped working' or they worked but not in the way the client expected!
The code below rebuilds the calendar profile documents $FilterFormula_X rule set -– the compiled rules. Once cleaned up the users' mail rules will once again be enabled.
Note: This code can be put into a button/hotspot and sent in an e-mail to the client who needs to have the problem repaired. Just remember to embed the form in the document when sending the message
Option Declare Dim vwRules As NotesView Dim s As NotesSession Dim db As NotesDatabase Dim vwRuleNav As NotesViewNavigator Dim activeRules () As NotesDocument Dim ve As notesviewentry Const vwRuleNm = "(Rules)" Const FLD_ENABLE_NM = "Enable" Const FLD_ENABLE_VAL = "1" Const FLD_DISABLE_VAL = "0" Const FLD_ORDER_NM = "OrderNum" 'messagebox constants Const MB_OK = 0 ' OK button only Const MB_OKCANCEL = 1 ' OK and Cancel buttons Const MB_YESNOCANCEL = 3 ' Yes, No, and Cancel buttons Const MB_YESNO = 4 ' Yes and No buttons Const MB_RETRYCANCEL = 5 ' Retry and Cancel buttons Const MB_ICONSTOP = 16 ' Critical message Const MB_ICONQUESTION = 32 ' Warning query Const MB_ICONEXCLAMATION = 48 ' Warning message Const MB_ICONINFORMATION = 64 ' Information message Const IDYES = 6 ' ********** error & progress messages ********** Dim msg As String, msgTitle As String, msgBase As String, msgEnd As String Const MSG_STOP = &h00000100& Const MSG_COMPLETE = &h00000101& Const MSG_ERR_BASE = &h00000102& Const MSG_ERR_END = &h00000103& Const MSG_COMPLETE_BASE = &h00000104& Const MSG_COMPLETE_END = &h00000105& Const MSG_TOO_MANY_RULES_BASE = &h00000106& Const MSG_TOO_MANY_RULE_END = &h00000107& Const MSG_TOO_MANY_RULES_ABORT_BASE = &h00000108& Const MSG_TOO_MANY_RULES_ABORT_END = &h00000109& Const MSG_TOO_MANY_RULES = &h00000110& Const MSG_ABORT = &h00000111& Const MSG_NO_FLDR = &h00000001& Const MSG_RULE_NOT_FOUND = &h00000002& Sub Click(Source As Button) On Error Goto processError Dim ret As Integer ' return value Dim nl As String ' newline constant Dim x As Integer ' a counter Let nl = Chr(10) Set s = New notessession Set db = s.Currentdatabase Set vwRules = db.GetView (vwRuleNm) If vwRules Is Nothing Then msg = GetLocalString (MSG_NO_FLDR) Goto fatalError End If ' get all active rules Set vwRuleNav = vwRules.CreateViewNav Set ve = vwRuleNav.GetFirst () Redim activeRules (0) As NotesDocument While Not ve Is Nothing If ve.Document.GetItemValue (FLD_ENABLE_NM)(0) = FLD_ENABLE_VAL Then If Not activeRules (Ubound (activeRules)) Is Nothing Then Redim Preserve activeRules (Ubound (activeRules) + 1) As NotesDocument Set activeRules (Ubound (activeRules)) = ve.Document End If Set ve = vwRuleNav.GetNextDocument (ve) Wend ' test to see if there are too many rule documents to have enabled -- router max is 100, but practical limit may be less If Ubound (activeRules) > 99 Then Let msgTitle = GetLocalString (MSG_TOO_MANY_RULES) Let msgBase = GetLocalString (MSG_TOO_MANY_RULES_BASE) Let ret = Messagebox (msgBase , MB_ICONQUESTION + MB_YESNOCANCEL, msgTitle) If ret <> IDYES Then Let msgTitle = GetLocalString (MSG_ABORT) Let msgBase = GetLocalString (MSG_TOO_MANY_RULES_ABORT_BASE) Let msgEnd = GetLocalString (MSG_TOO_MANY_RULES_ABORT_END) Messagebox msgBase & nl & msgEnd, MB_ICONSTOP, msgTitle Exit Sub Else %REM disables rule documents > 99 arbitrarily start numbering documents at 500 ensuring these rules will appear at end of rule list %END REM Call RemoveExcessRules (activeRules, 99, 500) End If End If ' now compact and compile remaining rules Let ret = CompactMailRules (activeRules) If ret <> 0 Then Let msgTitle = GetLocalString (MSG_COMPLETE) Let msgBase = GetLocalString (MSG_COMPLETE_BASE) Let msgEnd = GetLocalString (MSG_COMPLETE_END) Messagebox msgBase & msgEnd, MB_ICONSTOP, msgTitle End If Exit Sub processError: Let msgTitle = GetLocalString (MSG_STOP) If msg = "" Then Let msg = "Error code: " & Cstr(Err) & " line: " & Cstr(Erl) & "[" & Error$ & "]" End If Let msgBase = GetLocalString (MSG_ERR_BASE) Let msgEnd = GetLocalString (MSG_ERR_END) Messagebox msgBase & nl & msg & nl & msgEnd, MB_ICONSTOP, msgTitle Resume out fatalError: Let msgTitle = GetLocalString (MSG_STOP) Let msgBase = GetLocalString (MSG_ERR_BASE) Let msgEnd = GetLocalString (MSG_ERR_END) Messagebox msgBase & nl & msg & nl & msgEnd, MB_ICONSTOP, msgTitle Resume out out: End Sub Function CompactMailRules (m_ruleArray () As NotesDocument) As Integer Dim note As NotesDocument Dim item As notesitem Dim orderItem As NotesItem Dim orderNum As Integer Dim profile As notesdocument Dim strFilterItem As String Dim x As Integer, i As Integer Dim IsRuleEnabled As Integer '// Flag On Error Goto processError Set profile= db.GetProfileDocument ("CalendarProfile") If Not(profile Is Nothing) Then '//Clean Profile from all $FilterFormula_x Forall items In Profile.items If items.type = 1536 Then If Instr (1, items.name, "_0", 5) = 0 Then Call items.remove() Else ' leave it there -- it probably is the MiniView rule for calendar appointments End If End If End Forall For i=0 To Ubound (m_ruleArray) Set note = m_ruleArray (i) Set item = note.GetFirstItem ("$FilterFormula") strfilteritem = "$FilterFormula_"+Cstr(x+1) Call item.copyitemtodocument (profile,strfilteritem) x = x + 1 'Rules always starts with #1 - 0 is reserved If note.HasItem ("OrderNum") Then Set orderItem = note.GetFirstItem ("OrderNum") If orderItem.Type = 1280 Then ' text value Let orderNum = Cint(orderItem.Values (0)) Elseif orderItem.Type = 768 Then ' number value Let orderNum = Cint(orderItem.Values (0)) Else Let orderNum = 1000 End If End If If (orderNum <> (i+1)) Then Call note.replaceitemvalue("OrderNum",(i+1)) Call note.Save(True,True) End If Next Call profile.replaceitemvalue ("$FilterFormulaCount",Cstr(x)) '//replace total count of existing enabled rules Call profile.save(True, True, True) '//saving profile End If CompactMailRules = x Exit Function processError: Let Msg = Lsi_info(2) & " line " & Cstr(Erl) & ": " & Error$ & " [" & Cstr (Err) & "]" Error Err, Msg End Function Function GetDocumentBySearch (m_db As NotesDatabase, m_qstring As String, m_dt As NotesDateTime) As NotesDocumentCollection Set GetDocumentBySearch = m_db.Search (m_qstring, m_dt, 0) End Function Function GetLocalString (strVar As Variant) As String Select Case strVar Case MSG_NO_FLDR GetLocalString = "The Rules folder could not be found" Case MSG_STOP GetLocalString = "Operation Incomplete" Case MSG_COMPLETE GetLocalString = "Rule Cleanup Complete" Case MSG_COMPLETE_BASE GetLocalString = |Mail rules documents have successfully been synchronized with your calendar profile.| Case MSG_COMPLETE_END GetLocalString = "" Case MSG_ERR_BASE GetLocalString = "An error occured while trying to clean up rules with the message" Case MSG_ERR_END GetLocalString = "Please contact ** PUT YOUR NAME HERE ** for further assistance." Case MSG_RULE_NOT_FOUND GetLocalString = "The specified SPAM rule document cannot be found in this database." Case MSG_TOO_MANY_RULES_BASE GetLocalString = |You have too many rule documents -- you can create a maximum of 99 rules. If you continue, the first 98 rules will be enabled, while the remaining rules will be disabled.| Case MSG_TOO_MANY_RULE_END GetLocalString = "Do you want to continue?" Case MSG_TOO_MANY_RULES_ABORT_BASE GetLocalString = |Please review your enabled Rules. 1) Disable rules which no longer apply 2) Add individual addresses using the 'Block Sender List' 3) Combine rules if possible| Case MSG_TOO_MANY_RULES_ABORT_END GetLocalString = "Please call ** PUT YOUR NAME HERE ** if you have further questions." Case MSG_TOO_MANY_RULES GetLocalString = "Cleanup" Case MSG_ABORT GetLocalString = "Cleanup Stopped" End Select End Function Function RemoveExcessRules (m_rules () As NotesDocument, m_start As Integer, m_order As Integer) Dim counter As Integer Dim m_ruleDoc As NotesDocument For counter = m_start To Ubound (m_rules) Set m_ruleDoc = m_rules (counter) Call m_ruleDoc .ReplaceItemValue (FLD_ENABLE_NM, FLD_DISABLE_VAL) Call m_ruleDoc .ReplaceItemValue (FLD_ORDER_NM, Cstr(counter + m_order)) Call m_ruleDoc .Save (True, False, True) Next End Function
Do you have comments on this tip? Let us know.
This tip was submitted to the SearchDomino.com tip exchange by member Terry Traphagen. Please let others know how useful it is via the rating scale at the end of the tip. Do you have a useful Notes/Domino tip or code to share? Submit it to our monthly tip contest and you could win a prize and a spot in our Hall of Fame.