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.
This was first published in November 2004