LotusScript agent to send field values, sorted by field

This sends a list of field values for the document currently open via email. You are prompted for the recipient when the agent is run. Unlike my previous post, it sorts the field names using Lotus' sample bubble sort function.

Select all the script below and paste it in the Declarations event of a LotusScript agent. Open the document you want the values for and run this agent from the Actions menu.

Sub Initialize     
   ' this uses the bub_sort function from Lotus KB
     Dim session As New NotesSession
     Dim workspace As New NotesUIWorkspace
     Dim uidoc As NotesUIDocument
     Set uidoc = workspace.CurrentDocument
     Dim doc As NotesDocument
     Set doc = uidoc.document
     Dim db As NotesDatabase
     Set db = doc.ParentDatabase

     ' create a field to hold all the field names
     Dim allfields As NotesItem          If Not (doc.hasitem("allfields")) Then
          Set allfields = doc.AppendItemValue("allfields","")
     Else
          Set allfields = doc.GetFirstItem("allfields")
          allfields.Values = ""
     End If

     ' populate that field with all the field names
     Dim fieldnames As Variant
     Forall item In doc.items
          If Not (item.name = "allfields") Then
               Call allfields.AppendToTextList(item.name)
          End If
     End Forall

     ' use bubble sort from Lotus support to put fields in alphabetical order
     Dim myarray As Variant
     myarray = allfields.values
     Call bub_sort(myarray)
     allfields.values = myarray

     ' Create a mail memo
     Dim newdoc As NotesDocument
     Set newdoc = db.CreateDocument
     newdoc.Form = "Memo"
     therecipient = Inputbox ( "Please type a name to send this 
to","",session.EffectiveUserName)
     newdoc.SendTo = therecipient
     newdoc.Subject = "Field values"

     ' populate the body of the memo
     Dim r As Variant
     Set r = newdoc.CreateRichTextItem("Body")
     Dim docitem As NotesItem
     Dim mystring As String
     Dim stuffx As String

     Forall itemname In allfields.values
          Call r.AppendText(itemname)
          ' Ascii 9 is horizontal tab - used to separate field name from value
          ' This makes it easy to copy the results to a spreadsheet
          Call r.AppendText(Chr(9))
          Set docitem=doc.GetFirstItem(itemname)
          ' the item must not be a rich text item
          ' rich text items return false for their issummary property
          If docitem.issummary Then
               stuffx = ""
               ' for multi-item values return all values separated by a space
               Forall v In docitem.values
                    stuffx = stuffx & " " & v
               End Forall
               Call r.AppendText(stuffx)
          End If
          Call r.AddNewLine(1)
     End Forall
     Call newdoc.send(False)
     Call doc.RemoveItem("allfields")
End Sub

Sub bub_sort (in_array As Variant)' This code is from the public Lotus site and is assumed to be the intellectual property of 
IBM Corporation.
          'returns a sorted array based on a complexity of O(n^2) using a bubble sort
      If Not Isarray(in_array) Then
          Print "bub_sort: not receiving array"
          Exit Sub
     End If

     Dim top, bot, cur, cur2 As Integer
     top=Ubound (in_array)
     bot=Lbound (in_array)

     If top=bot Then
          Print "bub_sort: only one element"
          Exit Sub
     End If

     Dim tmp_element As Variant

     For cur=bot To top
          cur2=cur
          Do While cur2 > bot 'bubble up
               If (in_array(cur2) > in_array(cur2-1)) Then
                    Exit Do
               Else
'swap
                    tmp_element=in_array(cur2)
                    in_array(cur2)=in_array(cur2-1)
                    in_array(cur2-1)=tmp_element
               End If
               cur2=cur2-1
          Loop
     Next
End Sub