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