Thursday 14 November 2019

VBA - ADO - Recordset.GetRows method allows SQL column selection but CopyFromRecordset doesn't

I like ADO recordsets even though they are old school, they dovetail well with Excel VBA especially in that one can call the Range.CopyFromRecordset method and get a recordset written to a block of sheets in super quick time. However, in this post I show the Recordset.GetRows method which allows SQL column selection (technically known as projection) which is something lacking with CopyFromRecordset.

So the code below has two functions, the bottom function is just to create a test recordset because not everybody has a database lying around to which they can make queries, so there is nothing to see there. What there is to see is the top function which contains calls to the Recordset.GetRows method to return a rectangular two dimensional variant array which can easily be pasted onto a range of cells on a worksheet. If you are wondering why take two steps when CopyFromRecordset takes one then consider the parameters for CopyFromRecordset shown here immediately below

So in the first parameter Range.CopyfromRecordset takes a recordset and the remaining two parameters allow the rows and columns to be capped but there is no parameter by which to select the columns. But in the code below, specifically in the second call to GetRows we can specify a Fields parameter which is an array of field names. Cool.

Why does this matter (to me) ? Well, ADO recordsets are useful as 'state vehicles' or data marshalling devices in a distributed system. That is to say they can be used in network calls between separate machines on a network such as in a multi-tier (N-Tier) distributed system design pattern. Now that we know we can select columns we can engineer our system to be generous in columns knowing they can be selected out when writing to a worksheet.

Option Explicit

'* Tools -> References
'* Microsoft ActiveX Data Objects x.y Library

Function ProjectRecordset()
    Dim rstADO As ADODB.Recordset
    Set rstADO = CreateTestRecordset_NothingToSeeHere

    '* you need to move the cursor to first record
    rstADO.MoveFirst
    
    
    Dim vAllColumns As Variant
    vAllColumns = rstADO.GetRows()
    
    Debug.Assert UBound(vAllColumns, 1) - LBound(vAllColumns, 1) + 1 = rstADO.Fields.Count
    
    '* reset the cursor by moving it back to first record
    rstADO.MoveFirst
    
    '    ____      _   ____                         _                                   _           _   _ _
    '   / ___| ___| |_|  _ \ _____      _____    __| | ___   ___  ___   _ __  _ __ ___ (_) ___  ___| |_(_) ___  _ __  ___
    '  | |  _ / _ \ __| |_) / _ \ \ /\ / / __|  / _` |/ _ \ / _ \/ __| | '_ \| '__/ _ \| |/ _ \/ __| __| |/ _ \| '_ \/ __|
    '  | |_| |  __/ |_|  _ < (_) \ V  V /\__ \ | (_| | (_) |  __/\__ \ | |_) | | | (_) | |  __/ (__| |_| | (_) | | | \__ \
    ' (_)____|\___|\__|_| \_\___/ \_/\_/ |___/  \__,_|\___/ \___||___/ | .__/|_|  \___// |\___|\___|\__|_|\___/|_| |_|___/
    '                                                                  |_|           |__/
    
    
    Dim vSubselectionOfColumns As Variant
    vSubselectionOfColumns = rstADO.GetRows(, , Array("Animal", "ArrivalSequence"))

    Debug.Assert UBound(vSubselectionOfColumns, 1) - LBound(vSubselectionOfColumns, 1) + 1 = 2

    Dim rngDestination As Excel.Range
    'Set rngDestination = Workbooks("Foo").Worksheets("Bar").Range("a1")   '<---- Placeholder workbook and worksheet names
    'rngDestination.CopyFromRecordset  '<--- no parameter to select columns

    Stop  '* this is here so you can browse the Locals Window
    
End Function



Function CreateTestRecordset_NothingToSeeHere() As ADODB.Recordset

    '* Nothing to see here!  This is just some code to create a recordset out of thin air.
    '* Because not everybody has a database lying around to which they can make queries.
    '* The real lesson of this post is above in the GetRows method call
    
    Dim rstADO As ADODB.Recordset
    Dim fld As ADODB.Field
    '* Nothing to see here!
    Set rstADO = New ADODB.Recordset
    With rstADO
        '* Nothing to see here!
        .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, 6)
        
    End With

    Set CreateTestRecordset_NothingToSeeHere = rstADO
    '* Nothing to see here!
End Function

No comments:

Post a Comment