Doug Coats Doug Coats - 3 months ago 14
SQL Question

SQL Query to VBA Array

As the title suggests I am looking into different ways to store the contents of a query into an array. I have been experimenting with different varieties of doing this, but it seems to be that most of these ways are in correct in their output. This is of course do to my lack of understanding of how this is supposed to be appropriately done, so after a while of experimenting I have decided to ask whats the best approach for this? I will share with you some of my approaches thus far and you can see where my investigation has landed me.

Dim MyArray() As Variant
MyArray = rst.GetRows(rst.RecordCount)


This was ok yet this stored all the information vertically instead of horizontally. Is there a way to flip that? Would that be through the use of ReDim? Or is this due to the fact the rows are getting stored in array dimensions and thus they naturally vertical?

Index = 0
Do While Not rst.EOF
ReDim Preserve MyArray(1, Index)
MyArray(0, Index) = CStr(rst.Fields(0).Value)

'Safety check to make sure the value isn't null (was having problems before)
If rst.Fields(1).Value <> vbNullString Then
MyArray(1, Index) = CStr(rst.Fields(1).Value)
End If
Index = Index + 1
rst.MoveNext
Loop

sheet.Range("a1:ba10000").Value = MyArray


This again stored things vertically, but didnt output the records correctly, and in fact only pull the first two columns of info per record, the rest was output as #N/A#. I think I was closer with my original approach, but decided experimenting might land me somewhere.

Do you peeps have some suggestions or can point me in the right direction?

Answer

I think it would be quicker to just dump the results to the sheet using:

Sheet1.Range("A1").CopyFromRecordset rst

And then store the results of that dump (from the range) into an array. If it isn't vertical or horizontal like you like, a quick copy/paste-special transpose will make very quick work of it, before bringing it back into the array.

I'm only suggesting that since it seems like your recordset is rather large (2x10000), so iterating as you are doing is going to be time consuming, where dumping the results to the worksheet, manipulating, and picking them back up should be very very quick.


I work with ADODB recordsets a lot in Excel, so I have a module that I just import to any sheet where I'm going to be connecting to a database. In it is a subroutine that I use where I just send it the SQL, a range to which it should drop the data and a flag if it should drop the headers too, and whether or not the function should handle the connection. That last flag is for when I want to open a connection, issue multiple SQL statements, then close it. Otherwise this just opens, runs the SQL, and closes.

Sub getData(strSQL As String, rngDrop As Range, Optional includeHeaders As Boolean = False, Optional handleConnection As Boolean = True)

    Dim rs As New ADODB.Recordset

    'Little error handling
    On Error GoTo errHandler

    'Open the database (seperate function for creating the connection object)
    If handleConnection Then openConnection

    'set up the recordset
    rs.ActiveConnection = adoConn
    rs.LockType = adLockOptimistic
    rs.CursorLocation = adOpenKeyset
    rs.Open strSQL

    'check for data
    If rs.EOF And rs.BOF Then
        Debug.Print "No data returned. Boo."
        Debug.Print "   Offending SQL:"
        Debug.Print "---------------------------"
        Debug.Print strSQL
        Debug.Print "---------------------------"
    End If

    'clear the range
    rngDrop.ClearContents

    'If the headers are requested, then dump those and offset(1) to dump the data
    If includeHeaders Then
        Dim header As field
        Dim intCol As Integer: intCol = 0

        For Each header In rs.Fields
            rngDrop.Cells(1, 1).Offset(0, intCol).value = header.Name
            intCol = intCol + 1
       Next header
       rngDrop.Cells(1, 1).Offset(1, 0).CopyFromRecordset rs
    Else
        'otherwise just dump the recordset
        rngDrop.CopyFromRecordset rs
    End If

    'clean up
    rs.Close
    If handleConnection Then adoConn.Close
    Exit Sub
errHandler:
    Debug.Print Err.description, vbCritical, "Error " & Err.Number
End Sub

I use dynamic named ranges for the range I pass into this function so that I can quick dump and then reference the data in the worksheet. This way the range to which we are dropping the data grows/shrinks with the data that is dropped to it. So fetching some data, with a header, bolding the header, then copying and transposing it elsewhere, and finally sticking it in an array would look like:

 Sub test()
     getData("Select f1, f2 FROM table;", Range("MyNamedRange"), True)
     Range("MyNamedRange").Rows(1).Font.Bold = True
     Range("MyNamedRange").Copy 
     Sheet2.Range("A1").pasteSpecial Transpose:=True
     Arr = Sheet2.Range("A1").Resize(Range("myNAmedRange).columns.count, Range("MyNamedRange").Rows.Count)
 End Sub

That could probably be cleaned up a bit, but it should work and it should be pretty quick.