Add or remove names to/from authornames fields

You Can View User Feedback To This Tip

This agent is runs on selected documents. It checks whether or not the user has the appropriate role to run the agent. Then it checks all the fields in selected document for authornames fields and lists them in a dialogbox. The user chooses which field to change and is then prompted for one or more new names.

 Sub Initialize
 Dim ws As New notesUIWorkspace
 Dim session As New notesSession
 Dim coll As notesDocumentCollection
 Dim doc As notesDocument
 Dim dlgDoc As notesDocument
 Dim msgTitle As String
 Dim valueArr As Variant
 Dim item As notesItem
 Dim fieldName As String
 Dim x As Integer
 Dim admin As Integer
 Dim roller As Variant
 
' ** Set header for msgboxes
 msgTitle = session.currentDatabase.title
' ** Chech for appropriate roles
 roller = Evaluate ("@UserRoles")
 Forall roll In roller
  If Lcase (roll) = "[admin]" Or Lcase (roll) = 
"[notesadmin]" Then
   admin = True
   Exit Forall
  End If
 End Forall
 
 If Not admin Then
  Msgbox "This action is allowed to Admins only!", 
64, msgTitle
  Exit Sub
 End If
 
 
 Set coll = session.currentDatabase.
unprocessedDocuments
 If coll.count = 0 Then
  Msgbox "No documents selecte in the view" 
& Chr (13) & "Action aborted.", 64, msgTitle
  Exit Sub
 End If
 
 Set doc = coll.getFirstDocument
 Set dlgDoc = session.currentDatabase.
createDocument ()
 dlgDoc.CollCount = Cstr (coll.count)
 
 Dim promptSvar As Variant
 Dim forf As Variant
 Dim forfattare () As String
 Dim forfattare2 As Variant
 x = 0

 forf = doc.items
 If Islist (forf) Or Isarray (forf) Then
  Forall falt In forf
   If falt.isnames Or falt.isAuthors Then
    Redim Preserve forfattare (x)
    forfattare (x) = falt.name     
    x = x + 1
   End If
  End Forall
  Stop
 End If
 
 forfattare2 = SortArray (forfattare)
 promptSvar = ws.Prompt( 5, msgTitle, 
"Choose field to alter.", , forfattare2 )
 
 If promptSvar = "" Then
  Msgbox "Action aborted by user.", 64, msgTitle
  Exit Sub
 End If
 
 fieldName = promptSvar
 
 valueArr = ws.picklistStrings (0, True)
 
 Do While Not doc Is Nothing
  Set item = doc.getFirstItem (fieldName)
  If Not Islist (item.values ) And Not Isarray 
(item.values) Then
   Call doc.replaceItemValue (fieldName, valueArr)
  Else
   Forall newAuthor In valueArr
    Call item.appendTotextList (newAuthor)
   End Forall
  End If
  
  Call doc.save (True, True)
  
  Set doc = coll.getNextDocument (doc)
 Loop
 
End Sub

Function SortArray (MyArray As Variant) As Variant
 If Ubound (MyArray) <= 0 Then 
  SortArray = MyArray
  Exit Function
 End If
 Dim nElem As Integer
 Dim indx As Integer
 Dim Large As String
 Dim i As Integer
 Dim j As Integer
 
 nElem = Ubound (MyArray) + 1
 For i = nElem - 1 To 1 Step -1
  Large$ = MyArray(0)
  indx = 0
  For j = 1 To nElem
   If j > i Then Exit For
   If Strcompare(MyArray(j), Large$) > 0 Then ' Ascending order
    Large$ = MyArray(j)
    indx = j
   End If 
  Next 
  MyArray(indx) = MyArray(i)
  MyArray(i) = Large$
 Next
 SortArray = MyArray
End Function
  
 

USER FEEDBACK TO THIS TIP

• This response is regarding the recent tip, "Add or remove names to/from authornames fields" Please tell your audience to be VERY careful using this code, as I have been bitten by this type of algorithm before. There is one small caveat: depending on the platform, using LotusScript to add/remove names from Authors (and Readers) fields renders them as TEXT ONLY fields. Thus, application security is null and void! There is, as I've discovered, a work-around. Once the add/remove processing is done, simply refer back to the applicable field as a NotesItem and set its IsAuthors flag to True. e.g.: NotesItem.IsAuthors = True This will keep your users out of each other's business! Happy developing. —Craig A. Benson
• I have not done any testing, but it seems that the statement "If falt.isnames Or falt.isAuthors Then" checks for both Names and Authors fields and not only Authos fields.—Michael M
• This is the remove part of my recently submitted tip. Here I assign .isAuthor or .isNames to the manipulated item.

    
    Sub Initialize   ' Agenten 2. Ta bort Names/Author
  ' ******************************************************
  **************************
   ' Agent to remove a name from a names och 
  authornamnes field. 
   ' Can be used as a manually trigged agent or you 
  can call it from a view or document action 
   ' Calls the function SortArray to sort the alternatives 
  in the dialog.
  ' *****************************************************
  ***************************
   Dim ws As New notesUIWorkspace
   Dim session As New notesSession
   Dim coll As notesDocumentCollection
   Dim doc As notesDocument
   Dim dlgDoc As notesDocument
   Dim msgTitle As String
   Dim value As String
   Dim item As notesItem
   Dim fieldName As String
   Dim x As Integer
   Dim admin As Integer
   Dim roller As Variant
   Dim authorFlag As Integer
   
  ' ** Set header for dialogs
   msgTitle = session.currentDatabase.title
  ' ** Check whether the user has the appropriate role
   roller = Evaluate ("@UserRoles")
   Forall roll In roller
    If Lcase (roll) = "[admin]" Or Lcase (roll) = "[notesadmin]" 
  Then
     admin = True
     Exit Forall
    End If
   End Forall
   
   If Not admin Then
    Msgbox "Action allowed only to admins!" & Chr (13) 
  & "Action aborted", 64, msgTitle
    Exit Sub
   End If
  ' ** Get all selected docs
   Set coll = session.currentDatabase.unprocessedDocuments
  ' ** Check to see that there is docs selected
   If coll.count = 0 Then
    Msgbox "No document selected." & Chr (13) 
  & "Action aborted", 64, msgTitle
    Exit Sub
   End If
   
   Set doc = coll.getFirstDocument
  ' ** Create a temp doc to get selection from dialog 
  without manipulate "sharp" document.
   Set dlgDoc = session.currentDatabase.createDocument ()
   dlgDoc.CollCount = Cstr (coll.count)
   
   Dim forf As Variant  ' Blir en array av items
   Dim forfattare () As String ' Array to store 
  authornames/names fieldnames
   Dim forfattare2 As Variant ' Need another array to sort
   fieldsnames using function SortArray.
   x = 0
   
  ' ** Set array and loop it to sort out names and 
  authornames fields.
   forf = doc.items
  ' ** Check that array is not empty. If empty or nothing go 
  to label SLUT to clean vars and then end. 
  (slut meens end in swedish and nothing else :)
   If Islist (forf) Or Isarray (forf) Then
    x = 0
  ' ** Loop  array and sort out choosable fields
    Forall falt In forf
     If falt.isnames Or falt.isAuthors Then
      Redim Preserve forfattare (x)
      forfattare (x) = falt.name     
      x = x + 1
     End If
    End Forall
   Else 
    Msgbox "No names or authornames fields found!" 
  & Chr (13) & "Action aborted", 64, msgTitle
    Goto SLUT
   End If
  ' ** Sort the array
   forfattare2 = SortArray(forfattare)
   fieldName = ws.Prompt( 5, msgTitle, 
  "Choose field to alter.", , forfattare2 )
   
   If fieldName = "" Then
    Msgbox "Action aborted by user", 64, msgTitle
    Goto SLUT
   End If
   
  ' ** Check to see if the field to alter is single value
   Stop
   If Not Islist (doc.getItemValue (fieldName) )
   And Not Isarray (doc.getItemValue (fieldName) ) Then
    Msgbox "This field is a singlevalued field.  
  You are not allowed to remove a name from this field." &_
    Chr (13) & "Action aborted.", 64, msgTitle
    Goto SLUT
   Elseif Ubound (doc.getItemValue (fieldName) ) = 0 
  Then
    Msgbox "This field is a singlevalued field. 
   You are not allowed to remove a name from this field." &_
    Chr (13) & "Action aborted.", 64, msgTitle
    Goto SLUT
   Else
    ' ** Unfortunatly we can´t use coll.StampAll 
  since we are manipulating multivalue fields.
    ' ** Loop doccollection and update selected docs.
    Dim tmpArr As Variant
    tmpArr = doc.getItemValue (fieldName)
    value = ws.Prompt( 5, msgTitle, "Choose name to remove.", , tmpArr )
    Do While Not doc Is Nothing
     tmpArr = doc.getItemValue (fieldName)
     dlgDoc.fieldName = SortArray (tmpArr)
     dlgDoc.value = value
    ' ** Remove name from field
     tmpArr = Evaluate (|@Trim (@Replace (fieldName; value; "") )|, dlgDoc)
    ' ** Set docfield with appropriate values.
     Set item = doc.getFirstItem (fieldName)
     If item.isAuthors Then authorFlag = True
     Call doc.replaceItemValue (fieldName, tmpArr)
     Set item = doc.getFirstItem (fieldName)
     If authorFlag Then
      item.isAuthors = True
     Else
      item.isNames = True
     End If 
     Call item.copyItemToDocument (doc, "")
     Call doc.save (True, True)
     
     Set doc = coll.getNextDocument (doc)
    Loop
   End If
  ' ** Refresh view
   Call ws.viewrefresh
   
  SLUT:
   Set session = Nothing
   Set ws = Nothing
   Set coll = Nothing
   Set doc = Nothing
   Set dlgDoc = Nothing
   Set item = Nothing
   Set forf = Nothing
   Set forfattare2 = Nothing
  End Sub
  
  Function SortArray (MyArray As Variant) As Variant
   If Ubound (MyArray) <= 0 Then 
    SortArray = MyArray
    Exit Function
   End If
   Dim nElem As Integer
   Dim indx As Integer
   Dim Large As String
   Dim i As Integer
   Dim j As Integer
   
   nElem = Ubound (MyArray) + 1
   For i = nElem - 1 To 1 Step -1
    Large$ = MyArray(0)
    indx = 0
    For j = 1 To nElem
     If j > i Then Exit For
     If Strcompare(MyArray(j), Large$) > 0 Then ' Ascending order
      Large$ = MyArray(j)
      indx = j
     End If 
    Next 
    MyArray(indx) = MyArray(i)
    MyArray(i) = Large$
   Next
   SortArray = MyArray
  End Function
    

  — Ulf Bark