Saturday, 27 October 2018

VBA - Fabricate an ADO Recordset for Sorting and Filtering

In VBA we can fabricate an ADO Recordset without any database whatsoever. Then we can take advantage of filtering and sorting.

This is in response to a Stack Overflow question - How to sort a subset according to some ordered superset?


Sub Test()

    Dim rstADO As ADODB.Recordset
    Dim fld As ADODB.Field

    Set rstADO = New ADODB.Recordset
    With rstADO
        .Fields.Append "Animal", adVarChar, 20
        .Fields.Append "BirthDay", adDate, FieldAttributeEnum.adFldKeyColumn
        .Fields.Append "ArrivalSequence", adInteger
    
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
        
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Cow", Now() - 200, 1)
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Horse", Now() - 100, 2)
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Pig", Now() - 150, 3)
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Chicken", Now() - 120, 4)
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Goat", Now() - 180, 5)
        .AddNew Array("Animal", "BirthDay", "ArrivalSequence"), Array("Dog", Now() - 140, 5)
        
        
        .Filter = "Animal='Cow' or Animal='Dog' or Animal='Pig'  or Animal='Horse'"
        
        Dim vSnap As Variant
        .MoveFirst
        vSnap = .GetRows
        
        Debug.Assert vSnap(0, 0) = "Cow"
        Debug.Assert vSnap(0, 1) = "Horse"
        Debug.Assert vSnap(0, 2) = "Pig"
        Debug.Assert vSnap(0, 3) = "Dog"
        
        
        '*
        '* Now sort according to birthday
        '*
        .Sort = "BirthDay"
        
            
        Dim vSnap2 As Variant
        .MoveFirst
        vSnap2 = .GetRows
        
        Debug.Assert vSnap2(0, 0) = "Cow"
        Debug.Assert vSnap2(0, 1) = "Pig"
        Debug.Assert vSnap2(0, 2) = "Dog"
        Debug.Assert vSnap2(0, 3) = "Horse"
            
            
    End With

End Sub

Links

No comments:

Post a Comment