NotesDocumentCollection で取得した複数の値をソートする

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





またはこちらで(英語) ⇒http://per.lausten.dk/blog/2006/10/sorting-notesdocumentcollection-by.html

LotusScript
katoman
July 1, 2015 5:07 PM
Rating
0





No comments yetLogin first to comment...