Good Day
Is there anyway to monitor or extract all rules created by end users on a server
Please help
Subject: Monitor all clients rules on aserver
You can run an agent similar to this one. It will search fo “redirection rules” outside tour domain.
Sub Click(Source As Button)
On Error Goto erreur
Dim uiws As New notesuiworkspace
Dim bOkToProcess As Integer
Dim session As New notessession
'Set session = New notessession
'bOkToProcess = ProcessCalRule( calprofile )
Dim ws As NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim dbcourant As NotesDatabase
Set dbcourant = session.currentdatabase
Dim NAB As NotesDatabase
Dim NABServer As String
Dim NABView As NotesView
Dim NABDoc As NotesDocument
cpt =0
Dim ServerMailFile As NotesDatabase
Dim ServerDirectory As NotesDbDirectory
Dim NABCollectList List As NotesDocumentCollection
Dim FileFromNABList List As String
Dim FileFromServerList List As ServerFileType
Set ws = New NotesUIWorkspace
Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document
'Specify the server from which to get user information
NABServer = “YOur servername”
'Open the Public Address Book
Print “Opening the Address Book”
Set NAB = Session.GetDatabase(NABServer,“names.nsf”)
TmpServer = Inputbox(“Enter the server to search”,“Name”,“”)
’ If NAB.IsOpen Then
'Server\Mail users view and place all the documents in a collection (one for each server)
Set NABView = NAB.GetView(“Mail Users”)
FileCount%=0
Print “Getting directory information”
'For each speficied server, find all the mail files (you might need to edit this section to specify the correct mail directory)
Forall TKServer In doc.ServerToSearch
Set ServerDirectory = Session.GetDbDirectory(Cstr(TmpServer))
Set ServerMailFile = ServerDirectory.GetFirstDatabase(DATABASE)
While Not ServerMailFile Is Nothing
If Left$(Ucase$(ServerMailFile.FilePath),5) = "MAIL" And Mid$(Ucase$(ServerMailFile.FilePath),6,7) <> “CLUSTER” Then
’ bOkToProcess = ProcessCalRuleDb( db )
FileFromServerList(FileCount%).FilePath = Left$(Ucase$(ServerMailFile.FilePath),Instr(1,Ucase$(ServerMailFile.FilePath),“.NSF”)-1)
FileFromServerList(FileCount%).ServerName = TKServer
FileFromServerList(FileCount%).Owner = ServerMailFile.Title
End If
Set ServerMailFile = ServerDirectory.GetNextDatabase()
FileCount%=FileCount%+1
Wend
End Forall
Forall FileFromServer In FileFromServerList
Found = False
Print "Checking mail file " + FileFromServer.FilePath
path = FileFromServer.FilePath
Set db = session.getdatabase (TmpServer,FileFromServer.FilePath) 'currentdatabase
Set db2 = session.currentdatabase
Set rulesFolder = db.GetView(“(Rules)”)
If Not(rulesFolder Is Nothing) Then
Set rulesCollection = rulesFolder.AllEntries
rulesCount = rulesCollection.count
If rulesCollection.Count > 0 Then w = 1
Set rulesEntry = rulesCollection.GetFirstEntry
While Not( rulesEntry Is Nothing )
Set rulesNote = rulesEntry.Document
If rulesNote.Action(0) = “B” Then
If Not( Ucase(Right(rulesNote.TokActionList(0),5) = “/DOmain” ) Or Ucase((Right(rulesNote.TokActionList(0),10) = “ABC.COM” ))) Then
Stop
Set docR = New NotesDocument(db2)
docR.form = “mailrule2”
docR.ActionList = rulesnote.ActionList(0)
docR.TokActionList = rulesnote.TokActionList(0)
docR.Enable = rulesnote.Enable(0)
docR.base = FileFromServer.FilePath
Call docR.Save(False, True)
End If
End If
w = w + 1
Set rulesEntry = rulesCollection.GetnextEntry( rulesEntry )
Wend
Else
Set maildoc = New NotesDocument(dbcourant)
maildoc.Form = “Memo”
maildoc.SendTo = “Your name”
maildoc.Subject = "Structure " + path
Call maildoc.Send (False)
End If
suivant:
End Forall
Else
Messagebox(“Unable to open the Address Book”)
End If
Erreur:
cpt = cpt +1
If cpt = 100 Then
Exit Sub
End If
Set maildoc = New NotesDocument(dbcourant)
maildoc.Form = “Memo”
maildoc.SendTo = “You name”
maildoc.Subject = "Erreur " + path
Call maildoc.Send (False)
Goto suivant
End Sub