Add or remove names to/from authornames fields
This tip describes how to 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
- 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