Materializing any ADODB Query

Question

Following-up on Creating ADODB Parameters on the fly and pushing the "wrapping" of ADODB a step further, I have written two more classes that allows me to expose methods that don't require a Connection object, without returning an ADODB.Recordset.

Taking this method as a reference:

Public Function Execute(connection As ADODB.connection, ByVal sql As String, ParamArray parametervalues()) As ADODB.Recordset
    
    Dim Values() As Variant
    Values = parametervalues
    
    Dim cmd As ADODB.Command
    Set cmd = CreateCommand(connection, adCmdText, sql, Values)
    
    Set Execute = cmd.Execute
    
End Function

A bit of context

I'm not comfortable with the idea of exposing a method that would return an ADODB.Recordset without taking in an ADODB.Connection, because this would mean opening a connection in a function that doesn't control when the connection needs to be closed.

To address this issue, I added two private fields to my SqlCommand:

Private connString As String
Private resultFactory As New SqlResult

I'm using a pre-determined connection string in Class_Initialize for the connString value:

Private Sub Class_Initialize()
    connString = Application.ConnectionString
End Sub

I adopted the "Quick" prefix to refer to an "overload" method that owns its own connection, hence the connection-less "overload" for the Execute method above will be called QuickExecute:

Public Function QuickExecute(ByVal sql As String, ParamArray parametervalues()) As SqlResult
        
    Dim parameters() As Variant
    parameters = parametervalues

    Dim connection As New ADODB.connection
    connection.ConnectionString = connString
    
    connection.Open
    
    Dim rs As ADODB.Recordset
    Set rs = Execute(connection, sql, parameters)
    
    Set QuickExecute = resultFactory.Create(rs)
    
    rs.Close
    Set rs = Nothing
    
    connection.Close
    Set connection = Nothing
        
End Function

The method consumes the recordset and returns an object that encapsulates its contents, a SqlResult object.

---

SqlResult

This type encapsulates a List<string> and a List<SqlResultRow> (see List class here), respectively holding field names and field values for each row.

Property Item has a procedure attribute that makes it the type's default property, and a procedure attribute of -4 on property NewEnum allows iterating the SqlResultRow items with a For Each loop, like this:

Dim sql As String
sql = "SELECT TOP 10 * FROM SomeTable"

Dim cmd As New SqlCommand
Dim result As SqlResult

Set result = cmd.QuickExecute(sql)

Dim row As SqlResultRow
For Each row In result
    Debug.Print row("SomeFieldName"), TypeName(row("SomeFieldName"))
Next

Here's the code:

Private Type tSqlResult
    FieldNames As List
    Values As List
    ToStringValueSeparator As String
End Type

Private this As tSqlResult
Option Explicit

Private Sub Class_Initialize()
    Set this.FieldNames = New List
    Set this.Values = New List
    this.ToStringValueSeparator = ","
End Sub

Public Property Get ValueSeparator() As String
    ValueSeparator = this.ToStringValueSeparator
End Property

Public Property Let ValueSeparator(ByVal value As String)
    this.ToStringValueSeparator = value
End Property

Public Sub AddFieldName(name As String)
    this.FieldNames.Add name
End Sub

Public Function FieldNameIndex(ByVal name As String) As Long
    FieldNameIndex = this.FieldNames.IndexOf(LCase$(name)) - 1
End Function

Public Sub AddValue(value As SqlResultRow)
    this.Values.Add value
End Sub

Public Property Get Count() As Long
    Count = this.Values.Count
End Property

Public Property Get Item(ByVal index As Long) As SqlResultRow
    Set Item = this.Values(index + 1)
End Property

Public Property Get NewEnum() As IUnknown
'Gets an enumerator that iterates through the List.
    
    Set NewEnum = this.Values.NewEnum

End Property

Public Function Create(adoRecordset As ADODB.Recordset) As SqlResult
    
    Dim result As New SqlResult
    Dim names As New List
    Dim fieldValues As New List
    
    Dim row As ADODB.fields
    Dim field As ADODB.field
    
    Dim rowFactory As New SqlResultRow
    
    Dim grabFieldName As Boolean
    grabFieldName = True
    
    While Not adoRecordset.BOF And Not adoRecordset.EOF
        
        For Each field In adoRecordset.fields
            If grabFieldName Then result.AddFieldName LCase$(Coalesce(field.name, vbNullString))
        Next
        
        result.AddValue rowFactory.Create(result, adoRecordset.fields)
        
        grabFieldName = False
        adoRecordset.MoveNext
    Wend
    
    Set Create = result
    
End Function

---

SqlResultRow

Each row encapsulates an array of Variant values, and has an Item property (which also has a procedure attribute that makes it the type's default property) that can take either a String representing a field's name, or any number representing a field's index. A ToString method conveniently outputs all field values separated by commas (the actual separator is configurable in the SqlResult class).

Private Type tRow
    ParentResult As SqlResult
    Values() As Variant
    IsEmpty As Boolean
End Type

Private this As tRow
Option Explicit

Private Sub Class_Initialize()
    ReDim this.Values(0 To 0)
    this.IsEmpty = True
End Sub

Public Property Set ParentResult(value As SqlResult)
    Set this.ParentResult = value
End Property

Friend Sub AddValue(ByVal value As Variant)
    
    If Not this.IsEmpty Then ReDim Preserve this.Values(0 To UBound(this.Values) + 1)
    this.Values(UBound(this.Values)) = value
    
    this.IsEmpty = False
    
End Sub

Public Property Get Item(nameOrIndex As Variant) As Variant
    
    If TypeName(nameOrIndex) = "String" Then
    
        Item = GetFieldValueByName(nameOrIndex)
    
    ElseIf IsNumeric(nameOrIndex) Then
    
        Item = GetFieldValueByIndex(nameOrIndex)
    
    Else
        
        'return empty variant
        
    End If
    
End Property

Private Function GetFieldValueByName(ByVal name As String) As Variant
    If Not this.IsEmpty Then GetFieldValueByName = this.Values(this.ParentResult.FieldNameIndex(name))
End Function

Private Function GetFieldValueByIndex(ByVal index As Integer) As Variant
    If Not this.IsEmpty Then GetFieldValueByIndex = this.Values(index)
End Function

Public Function Create(parent As SqlResult, fields As ADODB.fields) As SqlResultRow
    
    Dim result As New SqlResultRow
    Set result.ParentResult = parent
    
    Dim field As ADODB.field
    Dim value As Variant
    
    For Each field In fields
        If TypeName(field.value) = "String" Then
            value = LTrim(RTrim(Coalesce(field.value, vbNullString)))
        Else
            value = Coalesce(field.value, vbEmpty)
        End If
        result.AddValue value
    Next
    
    Set Create = result
    
End Function

Public Function ToString() As String
        
    If this.IsEmpty Then
        ToString = TypeName(Me)
        Exit Function
    End If
    
    Dim result As String
    result = Join(this.Values, this.ParentResult.ValueSeparator)
    
    ToString = result
    
End Function

The types are retained, so if a query returns a Date field, the type of that value will be Date in the SqlResultRow.

I use a small helper function, Coalesce, to deal with null values. For reference, here's the listing:

Public Function Coalesce(ByVal value As Variant, Optional ByVal value_when_null As Variant = 0) As Variant

    Dim return_value As Variant
    On Error Resume Next 'supress error handling

    If IsEmpty(value) Or IsNull(value) Or (TypeName(value) = "String" And value = vbNullString) Then
        return_value = value_when_null
    Else
        return_value = value
    End If

    Err.Clear 'clear any errors that might have occurred
    On Error GoTo 0 'reinstate error handling

    Coalesce = return_value

End Function

Answer 1

I want to focus on the SqlResult/SqlResultRow classes here. The way it is, it is analogous to having bought a huge expensive truck then insisting on driving the original dinky car that you wouldn't trade in and paying the payments on both the truck and the dinky car.

Why?

Because you're basically taking an ADODB.Recordset object, a full-featured entity that provides sorting, filtering, jumping to an arbitrary position, and few more. That's your expensive truck. You then painstakingly copy the contents of the recordset into a custom collection which has much less features... that's your dinky car.

Now, you are doing this for encapsulation and that's not a bad thing at all! However, what I propose is that instead of copying the content from a recordset to a custom collection, that you use the ADODB.Recordset as the implementation underneath the SqlResult class.

That way, it becomes very easy to wrap methods like sorting, filtering, jumping what have you. The consumers of the SqlResult class need not know about the recordset under the hood driving the class.

But, I don't want the connection leaking!

And that's a legit concern! However, with an ADODB.Recordset, it is easy to manage this. What you actually want is a disconnected recordset. That way, the contents of the recordset are all available in the user's computer's memory and there's no dangling connection. What you should do is basically something like this:

Public Function Execute(connection As ADODB.connection, ByVal sql As String, ParamArray parametervalues()) As ADODB.Recordset

    Dim Values() As Variant
    Values = parametervalues

    Dim cmd As ADODB.Command
    Set cmd = CreateCommand(connection, adCmdText, sql, Values)

    'Configure the recordset to use client-side snapshot
    'which is the only valid option for disconnected recordset
    'It needs not be readonly but updatable disconnected recordset
    'is needlessly complicating things anyway.
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    With rs
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
    End With

    'Load the recordset with result of the command
    'We can't assign rs directly from the Execute method of the cmd
    'or it'll coerce it to the wrong type of the recordset
    rs.Open cmd

    'Disconnect the recordset
    Set rs.ActiveConnection = Nothing        

    Set Execute = rs

End Function

Now we have a disconnected recordset that can be browsed, iterated, etc. and then provided to the SqlResult class.

That way the consumers need not know about the implementation of ADO but you still get all the goodness of ADODB.Recordset without incurring any extra costs and you can then modify the SqlResult class to wrap various features on the ADODB.Recordset for essentially free. By the same token, SqlResultRow is easier, since you can leverage the ADODB.Record or something similar. Now you're actually driving that fancy expensive truck, something you would have gotten anyway even if you didn't really needed all the features it has to offer.

Answer 2

A quick code inspection with MZ-Tools reveals the following:

Local variables names, fieldValues and row can be safely removed from the Create method.

That's all the tool is picking up though.

I like how it makes everything automagical, however if it were the only way to get the data I'd be worried about performance with some large recordsets. The List class makes it easier to find a value by field name, but the search for the field name happens every time, which means lots of time is spent wasted finding the same field index over and over again, for each record. Keeping the index for each name in a Dictionary<String,int> would be more efficient than having to search for each column index for each row.

That said, SqlCommand has methods that take a ADODB.Connection and output a ADODB.Recordset, having the possibility to use these methods for larger recordsets and let the client code deal with the connection and the recordset, somewhat makes up for the performance hit of the wrapper SqlResult; you get the automagical parameters and the possibility to only iterate the data once.

Answer 3

This loop (in SqlResult.Create):

For Each field In adoRecordset.fields
    If grabFieldName Then result.AddFieldName LCase$(Coalesce(field.name, vbNullString))
Next

will still iterate all fields even though grabFieldName is False. And since grabFieldName will only be True for the first record, why not just do it like this - and the flag should be called grabFieldNames, since the code is "grabbing" all field names:

If grabFieldNames Then
    For Each field In adoRecordset.fields
        result.AddFieldName LCase$(Coalesce(field.name, vbNullString))
    Next
End If

Speaking of AddFieldName, this implementation:

Public Sub AddFieldName(name As String)
    this.FieldNames.Add name
End Sub

Might work for most scenarios, but then if you want to have a Dictionary that maps field names to an index for more efficient field name lookups, a query like SELECT NULL AS Test, NULL AS Test will blow it up, since dictionary keys must be unique.

Given this field (see Dictionary implementation here):

Private nameIndices As New Dictionary

AddFieldName could look like this:

Public Sub AddFieldName(ByVal name As String)

    Static nameInstances As New Dictionary

    Dim localName As String
    localName = LCase$(name)

    If nameIndices.ContainsKey(localName) Then

        If nameInstances.ContainsKey(localName) Then
            nameInstances(localName) = nameInstances(localName) + 1
        Else
            nameInstances.Add localName, 1
        End If

        AddFieldName name & nameInstances(localName) 'recursive call

    Else
        this.FieldNames.Add localName
        nameIndices.Add localName, this.FieldNames.Count - 1
    End If

End Sub

This way the first Test field will be called Test, and the 2nd one will be called Test1, ensuring uniqueness of the field names. This could be quite surprising to the calling code, though, but selecting identically named columns shouldn't happen very often.

The FieldNameIndex function can then look like this:

Public Function FieldNameIndex(ByVal name As String) As Long

    Dim i As Long
    If nameIndices.TryGetValue(name, i) Then
        FieldNameIndex = i
    Else
        FieldNameIndex = -1
    End If

End Function

Answer 4

Is there any reason you don't use a disconnected record set and just close the connection in the function that opened it? I wouldn't keep a connection open any longer than you need.

<!doctype html>
<html>
<head>
<meta charset="utf-8">
<title>Untitled Document</title>
</head>

<body>
<p>This is a way I've found useful. The general idea is never keeping the connection open any longer than you have to. </p>
<pre>
Sub RunQuery()
    '    You can declare as many arrays as you need
    Dim RS1 As Variant
    Dim ParameterValues As String
    ParameterValues = "You can change this as needed"

    RS1 = GetDiscRecordset(ParameterValues)

    For c = LBound(RS1, 1) To UBound(RS1, 1)

        For r = LBound(RS1, 2) To UBound(RS1, 2)

            '    Iterate through the recordset
            Debug.Print RS1(c, r)


        Next r

    Next c
End Sub
</pre>

<p>The <b>GetDiscRecordset</b> function is similar to your execute function but we are returning a <i>Disconnected</i> recordset.</p>
<pre>
Function GetDiscRecordset(ParameterValues As String) As Variant
    Dim Qry As String

    Qry = "Select * From SourceTable Where [?PlaceHolder for Parameters?]" 'Modify as needed

    Qry = Replace(Qry, "[?PlaceHolder for Parameters?]", ParameterValues)

    Dim Conn As ADODB.connection

    Set Conn = New ADODB.connection

    Dim Rst As ADODB.Recordset

    Conn.ConnectionString = "Connection String" 'Modify as needed

    Conn.Open

    Set Rst = New ADODB.connection

    Set Rst.ActiveConnection = Conn

    '    Retrieve data
    Rst.CursorLocation = adUseClient

    Rst.LockType = adLockBatchOptimistic

    Rst.CursorType = adOpenStatic

    Rst.Open Qry, , , , adCmdText   '<- we set the rst stuff above so thats cool, thats our recordset

    '    NOW DISCONNECT RECORDSET HERE!
    Set Rst.ActiveConnection = Nothing

    Rst.MoveFirst
    '    Pass the recordset back
    GetDiscRecordset = Rst.GetRows
End Function

</pre>
</body>
</html>