ADO sort won't?

[TCARPENTER]

I have a disconnected recordset created from entity coordinates I'm trying to sort using the sort property of the recordset. My problem is the first column is sorted, but second is left alone. Anyone else seen this before?

I'm VB6 with all the latestest service packs and ADO 2.8 (I think with the latest service packs - maybe not)

Here's my code for the disconnected recordset:

  Dim rs As ADODB.Recordset  
  
  Set rs = New ADODB.Recordset
  
  With rs.Fields
    .Append "ObjRefKey", adChar, 500
    .Append "PntRefKey", adChar, 500
    .Append "X", adDouble
    .Append "Y", adDouble
    .Append "Z", adDouble
  End With

Then the recordset get populated from an Array, then sorted with:

  rs.Sort = "X Asc, Y Desc"

But here's what I get:

[tt]
79.1858441635922, 130.252103942296, 0
79.1858441635922, 155.857551744569, 0
79.1858441635922, 132.627103942296, 0
79.1858441635922, 90.6721039422956, 0
[/tt]

I was hoping for (done in Excel):

[tt]
79.1858441635922, 155.857551744569, 0
79.1858441635922, 132.627103942296, 0
79.1858441635922, 130.252103942296, 0
79.1858441635922, 90.6721039422956, 0
[/tt]

Is there something I'm missing? Any help is appreciated.

TIA
Todd

 

[JoeAtWork]

According to some article I just googled:

Note from the above that for Sort to work, the CursorLocation property is set to adUseClient ( 3 ) before the call to open the Recordset.

Maybe explicitely stting the CursorLocation property would help?

 

[Swi]

This has worked for me in the past:

Private Sub Command1_Click()
    Dim fso As FileSystemObject
    Dim fld As Folder
    Dim tfil As File
    Dim tFiles As Files
    Dim rs As ADODB.Recordset

    Set fso = New FileSystemObject
    Set rs = New ADODB.Recordset

    ' Create an empty recordset
    With rs
        .Fields.Append "File Name", adVarChar, 255
        .Fields.Append "Date", adDate
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
        .Open
    End With

    ' Loop through files in a folder
    Set fld = fso.GetFolder("C:\Test")
    Set tFils = fld.Files
    For Each tfil In tFils
        With rs
            .AddNew
            .Fields("File Name") = tfil
            .Fields("Date") = fso.GetFile(tfil).DateCreated
            .Update
        End With
    Next

    ' Sort the recordset by Date
    rs.Sort = "Date ASC"
    rs.MoveFirst

    ' Loop through sorted recordset
    Do
        MsgBox rs.Fields("File Name").Value & vbCrLf & _
        rs.Fields("Date").Value
        rs.MoveNext
    Loop Until rs.EOF

    ' Closes and destroys objects from memory
    rs.Close
    Set rs = Nothing
    Set tfil = Nothing
    Set tFiles = Nothing
    Set fld = Nothing
    Set fso = Nothing

    ' Prompt user of completion
    MsgBox "Done!", vbInformation
End Sub

Swi

 

[SBerthold]

>Is there something I'm missing?

I think you should double check the data being added to the right fields. It works fine for me, using your data. Maybe you should first isolate the proceedure and cut it down to just the bare necessities to see if just that works (just add the fields, four records, sort, and debug)

>Then the recordset get populated from an Array

Are you looping through the array, or assigning it to the Rs like this:

Dim aryValues
Dim aryFieldsList
aryFieldsList = Array("ObjRefKey", "PntRefKey", "X", "Y", "Z")

aryValues = Array("", "", 79.1858441635922, 130.252103942296, 0)
rs.AddNew aryFieldsList, aryValues
rs.Update

'Add more data

rs.Sort = "X Asc, Y Desc"

However, both cases do sort for me correctly.

 

[TCARPENTER]

NUTS!

Thanks all for the input, I have incorporated all of your suggestions and I'm still getting the same results.

However, when I used SBerthold's suggestion:

Sub TestADO()
  Dim rs As ADODB.Recordset
  
  Set rs = New ADODB.Recordset
  
  With rs
    .Fields.Append "ObjRefKey", adChar, 500
    .Fields.Append "PntRefKey", adChar, 500
    .Fields.Append "X", adDouble
    .Fields.Append "Y", adDouble
    .Fields.Append "Z", adDouble
  End With
  
  rs.CursorLocation = adUseClient
  rs.Open
  
  Dim aryValues
  Dim aryFieldsList
  
  aryFieldsList = Array("ObjRefKey", "PntRefKey", "X", "Y", "Z")
  
  aryValues = Array("EAIAABAAAADNFwEAAAAAAIAAAAAAAAAA", "EAIAABAAAADNFwEAAAAAAIAAAAAAAAAA", 252.799157349951, 130.252103942296, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update

  aryValues = Array("EAIAABAAAAC FwEAAAAAAIAAAAAAAAAA", "EAIAABAAAAC + FwEAAAAAAIAAAAAAAAAA", 252.799157349951, 90.6721039422956, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAAAc3AAAAAAAAIAAAAAAAAAA", "EAIAABAAAAAc3AAAAAAAAIAAAAAAAAAA", 139.222948559045, 155.857551744569, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAAAn3AAAAAAAAIAAAAAAAAAA", "EAIAABAAAAAn3AAAAAAAAIAAAAAAAAAA", 192.762052954498, 155.857551744569, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAADK2wAAAAAAAIAAAAAAAAAA", "EAIAABAAAADK2wAAAAAAAIAAAAAAAAAA", 192.762052954498, 132.627103942296, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAAAJqwAAAAAAAIAAAAAAAAAA", "EAIAABAAAAAJqwAAAAAAAIAAAAAAAAAA", 132.724948559045, 155.857551744569, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAABfAAAAAAAAAIAAAAAAAAAA", "EAIAABAAAABfAAAAAAAAAIAAAAAAAAAA", 132.724948559045, 132.627103942296, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAAB8AAAAAAAAAIAAAAAAAAAA", "EAIAABAAAAB8AAAAAAAAAIAAAAAAAAAA", 132.724948559045, 90.6721039422956, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAADb2wAAAAAAAIAAAAAAAAAA", "EAIAABAAAADb2wAAAAAAAIAAAAAAAAAA", 139.222948559045, 130.252103942296, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAADHFwEAAAAAAIAAAAAAAAAA", "EAIAABAAAADHFwEAAAAAAIAAAAAAAAAA", 199.260052954498, 130.252103942296, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAADMFwEAAAAAAIAAAAAAAAAA", "EAIAABAAAADMFwEAAAAAAIAAAAAAAAAA", 199.260052954498, 90.6721039422956, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAAATGAEAAAAAAIAAAAAAAAAA", "EAIAABAAAAATGAEAAAAAAIAAAAAAAAAA", 252.799157349951, 155.857551744569, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAADh2wAAAAAAAIAAAAAAAAAA", "EAIAABAAAADh2wAAAAAAAIAAAAAAAAAA", 192.762052954498, 130.252103942296, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAADS2wAAAAAAAIAAAAAAAAAA", "EAIAABAAAADS2wAAAAAAAIAAAAAAAAAA", 192.762052954498, 90.6721039422956, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAAAIGAEAAAAAAIAAAAAAAAAA", "EAIAABAAAAAIGAEAAAAAAIAAAAAAAAAA", 199.260052954498, 155.857551744569, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAADKFwEAAAAAAIAAAAAAAAAA", "EAIAABAAAADKFwEAAAAAAIAAAAAAAAAA", 199.260052954498, 132.627103942296, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAABdIwAAAAAAAIAAAAAAAAAA", "EAIAABAAAABdIwAAAAAAAIAAAAAAAAAA", 79.1858441635922, 130.252103942296, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAAC8qQAAAAAAAIAAAAAAAAAA", "EAIAABAAAAC8qQAAAAAAAIAAAAAAAAAA", 79.1858441635922, 155.857551744569, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAAAsMwAAAAAAAIAAAAAAAAAA", "EAIAABAAAAAsMwAAAAAAAIAAAAAAAAAA", 79.1858441635922, 132.627103942296, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAAChMwAAAAAAAIAAAAAAAAAA", "EAIAABAAAAChMwAAAAAAAIAAAAAAAAAA", 79.1858441635922, 90.6721039422956, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAADvMwAAAAAAAIAAAAAAAAAA", "EAIAABAAAADvMwAAAAAAAIAAAAAAAAAA", 132.724948559045, 130.252103942296, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAADg2wAAAAAAAIAAAAAAAAAA", "EAIAABAAAADg2wAAAAAAAIAAAAAAAAAA", 139.222948559045, 90.6721039422956, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
  aryValues = Array("EAIAABAAAAC2FwEAAAAAAIAAAAAAAAAA", "EAIAABAAAAC2FwEAAAAAAIAAAAAAAAAA", 252.799157349951, 132.627103942296, 0)
  rs.AddNew aryFieldsList, aryValues
  rs.Update
  
   
  rs.Sort = "X Asc, Y Desc"
  
  While Not rs.EOF
    Debug.Print rs.Fields("ObjRefKey").value & ", " & rs.Fields("PntRefKey").value & ", " & rs.Fields("X").value & ", " & rs.Fields("Y").value & ", " & rs.Fields("Z").value
    rs.MoveNext
  Wend
End Sub

- it worked so I must be doing something wrong when I load the recordset? So here's the entire function (not too long) is there something in there you guys can see I'm doing wrong?

Function SortArrayADO(vArray As Variant, OrderBy As PointSortOrder, Optional XOrder As String = "Asc", _
                                                                    Optional YOrder As String = "Asc", _
                                                                    Optional ZOrder As String = "Asc")
  Dim rs As ADODB.Recordset
  Dim lCnt As Long
  Dim bRefKey() As Byte
  Dim bConKey() As Byte
  Dim oEnt As SketchEntity
  Dim sEntRefKey As String
  Dim sPntRefKey As String
  Dim nArray() As Variant
    
  ReDim nArray(LBound(vArray, 1) To UBound(vArray, 1), LBound(vArray, 2) To UBound(vArray, 2))
  
  Set rs = New ADODB.Recordset
  
  With rs
    .Fields.Append "ObjRefKey", adChar, 500
    .Fields.Append "PntRefKey", adChar, 500
    .Fields.Append "X", adDouble
    .Fields.Append "Y", adDouble
    .Fields.Append "Z", adDouble
    .CursorLocation = adUseClient
    .Open
  End With
  
  ' Load the recordset
  '
  For lCnt = LBound(vArray) To UBound(vArray)
      
    Set oEnt = vArray(lCnt, 0)
    sEntRefKey = ReferenceKeyFromEntity(oEnt)
    
    Set oEnt = vArray(lCnt, 1)
    sPntRefKey = ReferenceKeyFromEntity(oEnt)
    
    rs.AddNew
      rs.Fields("ObjRefKey").value = sEntRefKey
      rs.Fields("PntRefKey").value = sPntRefKey
      rs.Fields("X").value = vArray(lCnt, 2)
      rs.Fields("Y").value = vArray(lCnt, 3)
      rs.Fields("Z").value = vArray(lCnt, 4)
    rs.Update
  
  Next lCnt
  
  'Now sort the recorset
  '
  Select Case OrderBy
    Case x
      rs.Sort = "X " & XOrder
    Case Y
      rs.Sort = "Y " & YOrder
    Case Z
      rs.Sort = "Z " & ZOrder
    Case x + Y
      rs.Sort = "X " & XOrder & ", Y " & YOrder
    Case x + Y + Z
      rs.Sort = "X " & XOrder & ", Y " & YOrder & ", Z " & ZOrder
      Debug.Print "rs.Sort = " & rs.Sort
    Case Else
      Debug.Print "No valid SortOrder found"
  End Select
  
  ' rs.Sort = "X Asc, Y Desc, Z Asc"
  rs.MoveFirst
  
  Debug.Print "rs.Sort = " & rs.Sort
  Debug.Print "After sort:"
  
  While Not rs.EOF
    Debug.Print rs.Fields("ObjRefKey").value & ", " & rs.Fields("PntRefKey").value & ", " & rs.Fields("X").value & ", " & rs.Fields("Y").value & ", " & rs.Fields("Z").value
    rs.MoveNext
  Wend
  
  
  ' Send back an ordered array
  '
  Debug.Print "After loading new Array:"
'  Set PointArray(lCnt, 0) = RetrnArray(0, 0) ' Selected Entity
'  Set PointArray(lCnt, 1) = RetrnArray(0, 1) ' StartPoint Entity of Selected Entity
'  PointArray(lCnt, 2) = RetrnArray(0, 2)     ' X coordinate
'  PointArray(lCnt, 3) = RetrnArray(0, 3)     ' Y coordinate
'  PointArray(lCnt, 4) = RetrnArray(0, 4)     ' Z coordinate
  
  
  Dim iRCnt As Integer
  iRCnt = 0
  
  rs.MoveFirst
    
  While Not rs.EOF
    
    For lCnt = LBound(vArray) To UBound(vArray)
      Set oEnt = vArray(lCnt, 1)
      sPntRefKey = ReferenceKeyFromEntity(oEnt)
      If rs.Fields("PntRefKey").value = sPntRefKey Then
        For iCnt = LBound(vArray, 2) To UBound(vArray, 2)
          If iCnt = 0 Or iCnt = 1 Then
            Set nArray(iRCnt, iCnt) = vArray(lCnt, iCnt)
          Else
            nArray(iRCnt, iCnt) = vArray(lCnt, iCnt)
          End If
        Next iCnt
      End If
    Next lCnt
    rs.MoveNext
    iRCnt = iRCnt + 1
  Wend
  
'  For lCnt = LBound(nArray, 1) To UBound(nArray, 1)
'    Debug.Print nArray(lCnt, 2); ", "; nArray(lCnt, 3); ", "; nArray(lCnt, 4)
'  Next lCnt
  
  SortArrayADO = nArray
  
  rs.Close
  Set rs = Nothing
  
End Function

Thanks again,
Todd

 

[SBerthold]

You need to do what I said. Cut the code down to the bare necessities and then work from there. Add pieces of it back as things start working. It'll help isolate the problem and give you a clearer view of things.
It is hard to say what
1. Start by removing this section completly:
' Send back an ordered array

2. Remove the sort Select Case and hard code the Sort order.

3. Remove the four lines starting with
"Set oEnt = vArray(lCnt, 0)"
and hard code the 1st and 2nd field values (use the same for all records) in just the two assignment lines.

4. Then use this to verify:

    Dim fld As ADODB.Field
    Debug.? rs.Sort
    rs.MoveFirst
    For lCnt = 0 To 1
        For Each fld In rs.Fields
            Debug.? fld.Name & ": Type=" & fld.Type & ": Value=" & fld.Value
        Next fld
        Debug.?
        rs.MoveLast
    Next lCnt

I did those changes in two minutes, and used 4 records assigned to an array in the fashion which you have given (shown below), and it worked just fine again.

Dim vArray(3, 4)
vArray(0, 0) = "A"
vArray(0, 1) = "B"
vArray(0, 2) = 79.1858441635922
vArray(0, 3) = 130.252103942296
vArray(0, 4) = 0

 

[TCARPENTER]

Hi SBerthold,

Thanks for hanging in there with me.

I incorporated the changes you suggested and didn't have much luck, however, I did get suspicious about an accuracy issue using a second data set. I incorporated this into my code and it now works - any idea why?

    rs.AddNew
      rs.Fields("ObjRefKey").value = sEntRefKey
      rs.Fields("PntRefKey").value = sPntRefKey
      rs.Fields("X").value = [purple][b]CDbl(CStr([/b][/purple]vArray(lCnt, 2)))
      rs.Fields("Y").value = [purple][b]CDbl(CStr([/b][/purple]vArray(lCnt, 3)))
      rs.Fields("Z").value = [purple][b]CDbl(CStr([/b][/purple]vArray(lCnt, 4)))
    rs.Update

Here's a chunk of the second set of data:

A, B, 482.040385773521, 124.326780077938, 0
A, B, 482.040385773521, 121.951780077938, 0
A, B, 482.040385773521, 87.8267800779376, 0
A, B, 482.040385773521, 169.27021590301, 0


I know the "fix" I've implemented is a "hack job" but since the numbers in the array are doubles, I thought the field should have been defined as a double as well?

Thanks again,
Todd

 

[SBerthold]

So, is the array declared as a string, or as a variant (delare it as a variant)?

Also, what happens when you do this instead:

= Str(vArray(lCnt, 2))

 

[TCARPENTER]

Hi SBerthold,

The array is declared as a variant, however, when first putting the function together, I ran this little chunk of code on the incoming array:

  For lCnt = LBound(vArray, 1) To UBound(vArray, 1)
    Debug.Print VarType(vArray(lCnt, 2))
    Debug.Print VarType(vArray(lCnt, 3))
    Debug.Print VarType(vArray(lCnt, 4))
  Next lCnt

2,3, and 4 reported being double. (0 and 1 are objects.)

Also, what happens when you do this instead:

= Str(vArray(lCnt, 2))

Worked just as well as = CDbl(CStr(vArray(lCnt, 2)))

Todd

 

[SBerthold]

Stick you debug code directly before the AddNew call and see what it shows.

 

[TCARPENTER]

Sorry, not sure which debug code you mean, if its this:

  For lCnt = LBound(vArray, 1) To UBound(vArray, 1)
    Debug.Print VarType(vArray(lCnt, 2))
    Debug.Print VarType(vArray(lCnt, 3))
    Debug.Print VarType(vArray(lCnt, 4))
  Next lCnt

it produces the same results.

Todd