Subject: RE: Update Author and Reader Fields After Group Rename
Hi,
you properbly checked that already but isnt there a "Perform request again? " option in each AdminP document …
If not and you really do the “repair” with an agent like File Save suggested, then maybe this will help you.
It does a similar thing but only works on specified fields in one database. I used it after a massive change of “cerfifiers” ( … but thats a name change as well or not :-)))
Bye
Hynek
'CheckDocumentAccess:
Option Public
Option Declare
Dim NAB As NotesDatabase
Dim NABView As NotesView
Sub Initialize
Dim Session As New NotesSession
Dim DB As NotesDatabase
Dim DocColl As NotesDocumentCollection
Dim Doc As NotesDocument
Dim counter As Long
Dim i As Long
Set DB= Session.CurrentDatabase
Set NAB = Session.GetDatabase(DB.Server,"names.nsf")
Set NABView = NAB.GetView("($Users)")
Set DocColl=DB.UnprocessedDocuments
Print "Processing " + Cstr(DocColl.Count) + " Documents"
For i=1 To DocColl.Count
Set Doc = DocColl.GetNthDocument(i)
If CheckDocumentAccess (Doc) = True Then
Counter = Counter + 1
End If
Next
Print "Changed access in reader fields for " & Cstr(Counter) & " documents"
End Sub
Function CheckDocumentAccess (Doc As NotesDocument) As Integer
Dim SaveFlag As Integer
CheckDocumentAccess = False
SaveFlag = False
' write all the fixed values
Dim FixedValues(8) As String
FixedValues(0) = "[Supervisor]"
FixedValues(1) = "[Director]"
FixedValues(2) = "[Shareholder]"
FixedValues(3) = "[Archivar]"
FixedValues(4) = "[FEO]"
FixedValues(5) = "[Controller]"
FixedValues(6) = "[ReaderAll]"
FixedValues(7) = "LocalDomainServers"
FixedValues(8) = "[EditorAll]"
' write all the fields
Dim Fields(1) As String
Fields(0) = "readers"
Fields(1) = "readers_2"
Forall Field In Fields
If SetReaderField (Field,Doc,FixedValues) = True Then
SaveFlag = True
End If
End Forall
If SaveFlag = True Then
Call Doc.Save(True,False,True)
CheckDocumentAccess = True
End If
End Function
Function SetReaderField (FieldName As String, Doc As NotesDocument, FixedValues As Variant) As Integer
Dim PersonDoc As NotesDocument
Dim Item As NotesItem
Dim User As NotesName
Dim NewValues As Variant
Dim PersonName As NotesName
Dim SaveFlag As Integer
SetReaderField = False
' get or create the item
If Doc.HasItem(FieldName) Then
Set Item = Doc.GetFirstItem(FieldName)
Else
Set Item = New NotesItem(Doc,FieldName,"",READERS)
SetReaderField = True
End If
NewValues = Item.Values
' check if the entries have the correct certifier
Forall entry In NewValues
If GetString(entry) <> "" Then
Set User = New NotesName(entry)
Set PersonDoc = NABView.GetDocumentByKey(Lcase(User.Common),True)
If Not PersonDoc Is Nothing Then
If PersonDoc.Form(0) = "Person" Then
Set PersonName = New NotesName(PersonDoc.Fullname(0))
If Not User.Canonical = PersonName.Canonical Then
' the names are not identical and will be replaced
entry = PersonName.Canonical
End If
End If
End If
End If
End Forall
' now add the fixed values if they do not exist
Forall entry In FixedValues
If entry <> "" Then
Call ArrayAddEntry(NewValues,entry,False)
End If
End Forall
' now make the array unique
NewValues = Arrayunique(NewValues,0)
'now sort the array alphabetically
Call ArraySort(NewValues)
'now compare the old values with the new one
If IsIdenticalArray(Item.Values,NewValues) = False Then
Item.Values = NewValues ' if they are different then change them
SetReaderField = True
End If
If Item.IsReaders = False Then
Item.IsReaders = True
SetReaderField = True
End If
End Function
Function GetString (entry As Variant) As String
Select Case Datatype (entry)
Case 0,1 ' Empty , NULL
GetString = ""
Case 2,3,4,5,6,7 ' Integer , Long , Single , Double , Currancy , Date/Time
GetString = Cstr(entry)
Case 8 ' String
GetString = entry
Case Else 'Everything else
GetString = ""
End Select
End Function
Function ArraySort (Array As Variant) As Variant
Dim n As Integer
Dim done As Variant
Dim Jump, i, j As Integer
Dim inter As Variant
n= Ubound(Array)
Jump = n
While Jump > 1
Jump = Jump \ 2
Do
done = True
For j = 0 To n - Jump
i = j + Jump
If Array(j) > Array(i) Then
inter = Array(i)
Array(i) = Array(j)
Array(j) = inter
done = False
End If
Next
Loop Until done
Wend
End Function
Function ArrayAddEntry (Array As Variant, entry As Variant, AddIfExists As Integer) As Variant
' at first check if the entry is not already in the array
If ArrayContains(Array,entry) = True Then
' if the value is found it should not be appended then return the unchanged array
If AddIfExists = False Then
Exit Function
End If
End If
If Not Array(Ubound(Array)) = "" Then
Redim Preserve Array (Ubound(Array) + 1)
End If
Array(Ubound(Array)) = entry
End Function
Function ArrayContains(Array As Variant,Value As Variant) As Integer
Forall entry In Array
If entry = Value Then
ArrayContains = True
Exit Function
End If
End Forall
ArrayContains = False
End Function
Function IsIdenticalArray (Array1 As Variant, Array2 As Variant) As Integer
Dim i As Double
If Ubound(Array1) <> Ubound(Array2) Then
IsIdenticalArray = False
Exit Function
End If
For i=0 To Ubound(Array1)
If Array1(i) <> Array2(i) Then
IsIdenticalArray = False
Exit Function
End If
Next
IsIdenticalArray = True
End Function
Sub Terminate
End Sub