Sorting a NotesDocumentCollection by multiple field values

Function sortCollection(coll As NotesDocumentCollection, fieldnames() As String) As NotesDocumentCollection
	
' Description:
' Sorts and returns a NotesDocumentCollection
' Fieldnames parameter is an array of strings
' with the field names to be sorted on
' 
' Modified by Per Henrik Lausten, November 2006 - http://per.lausten.dk/blog/	
' 
' Based on code by:
' Max Flodén - http://blog.tjitjing.com/index.php/2006/05/how-to-sort-notesdocumentcollection-in.html (used with permission from Max Flodén)
' Joe Litton - http://joelitton.net/A559B2/home.nsf/d6plinks/JLIN-5ZU3WH (used with permission from Joe Litton)
' Peter von Stöckel - http://www.bananahome.com/users/bananahome/blog.nsf/d6plinks/PSTL-6UWC7K
'
' Example of use
' Dim fieldnames(0 To 2) As String
' fieldnames(0) = "SKU"
' fieldnames(1) = "OrderDate"
' fieldnames(2) = "Client"
' Set collection = SortCollection (collection, fieldnames) 
	
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Dim collSorted As NotesDocumentCollection
	Dim doc As NotesDocument
	Dim i As Integer, n As Integer
	Dim arrFieldValueLength() As Long
	Dim arrSort, strSort As String
	
	Set db = session.CurrentDatabase
	
' ---
' --- 1) Build array to be sorted
' ---
	
	'Fill array with fieldvalues and docid and get max field length
	Redim arrSort(0 To coll.Count -1, 0 To Ubound(fieldnames) + 1)
	Redim arrFieldValueLength(0 To Ubound(fieldnames) + 1)
	For i = 0 To coll.Count - 1
		Set doc = coll.GetNthDocument(i + 1)
		For n = 0 To Ubound(fieldnames) + 1
			
			If n = Ubound(fieldnames) + 1 Then
				arrSort(i,n) = doc.UniversalID
				arrFieldValueLength(n) = 32
			Else
				arrSort(i,n) = "" & doc.GetItemValue(fieldnames(n))(0)
				' Check length of field value
				If Len(arrSort(i,n)) > arrFieldValueLength(n) Then
					arrFieldValueLength(n) = Len(arrSort(i,n))
				End If
			End If
			
		Next n
	Next i
	
	'Merge fields into array that can be used for sorting using the sortValues function
	Dim aryFieldValues() As String 
	For i = 0 To coll.Count - 1		
		Redim Preserve aryFieldValues(1 To i+1)
		
		strSort = ""
		For n = Lbound(fieldnames) To Ubound(fieldnames) + 1
			strSort = strSort & Left(arrSort(i,n) & Space(arrFieldValueLength(n)), arrFieldValueLength(n))
		Next n
		
		aryFieldValues(i+1) = strSort
	Next i

	
' ---
' --- 2) Sort array using sortValues function by Joe Litton
' ---
	arrSort = sortValues(aryFieldValues)
	
' ---
' --- 3) Use sorted array to sort collection
' ---
	Set collSorted = db.GetProfileDocCollection("Foo")  ' create an empty NotesDocumentCollection
	Forall y In arrSort
		Set doc = db.GetDocumentByUNID(Right(y, 32))
		Call collSorted.AddDocument(doc)
	End Forall
	
' ---
' --- 4) Return collection
' ---
	Set SortCollection = collSorted
	
End Function

Function sortValues(varValues As Variant) As Variant
	On Error Goto errHandler
    ' Use Shell sort to sort input array and return array sorted ascending
	
	Dim k As Integer
	Dim i As Integer
	Dim j As Integer
	Dim h As Integer
	Dim r As Integer
	Dim temp As String
	
     'Set up for Shell sort algorithm
	k = Ubound( varValues )
	h = 1
	Do While h < k
		h = (h*3)+1
	Loop
	h = (h-1)/3
	If h > 3 Then
		h = (h-1)/3
	End If
	
     'Shell sort algorithm
	Do While h > 0
		For i = 1+h To k
			temp = varValues(i)
			j = i-h
			Do While j >0
				If varValues(j)>temp Then
					varValues(j+h) = varValues(j)
					varValues(j) = temp
				Else
					Exit Do
				End If
				j = j-h
			Loop
		Next i
		h = (h-1)/3
	Loop
	
     'Write new sorted values    
	sortValues = varValues
	
getOut:
	Exit Function
	
errHandler:
	Dim strMsg As String
	strMsg = "Error #" & Err & Chr$(10) & Error$ & Chr$(10) & "Line #" & Erl & | in sub/function: "| & Lsi_info(2) & |"|
	Msgbox strMsg, 16, "Unexpected error"
	sortValues = "ERROR"
	Resume getOut
	
End Function