Fix client mail rules

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:

1. The mail rule document in the rules folder.
2. 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.