SQL Query to VBA Array

Question

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?

Solution 1

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.

---

Update (many years later). Looks like it's possible to dump into an array. Something like:

Dim arr
rst.MoveFirst
arr = rst.GetRows

This would allow for programatic manipulation of the recordset (in the array) before shooting the data out to the workbook.

Solution 2

This should work to answer your Question, albeit 5 years late. Recordset to Array to Worksheet

ReDim Preserve can only be used to resize the upperbound of the last previous dimension. You don't have 1 yet, so no ReDim Preserve.

'Goes on Top
Option Explicit
Option Compare Text
Option Base 1

Public Sub Recordset_to_Array_to_Worksheet()

Dim MyArray() As Variant 'unbound Array with no definite dimensions'
Dim db as DAO.Database
Dim rst as DAO.Recordset
Dim strSQL as String, Fieldname as String
Dim i as Integer, j as Integer, colcnt as Integer, rowcnt as Integer
Dim wb as Workbook
Dim ws as Worksheet
Dim Dest as Range

'------------------------RECORDSET------------------------'
Set db = Opendatabase("URL link") 'or Set db = Currentdb()
strSQL = "SQL Statement Here"

Set rst = db.OpenRecordset(strsQL, dbOpenDynaset)

If rst.recordcount <> 0 then '///Do NOT Use "Do While Not rst.EOF" Can cause Problems///'
    colcnt = rst.Fields.Count-1
    rowcnt = rst.recordcount
 Else
    Exit Sub
End IF

'-----------------------------WRITE RECORDSET TO MYARRAY----------------------------'
ReDim MyArray (rowcnt, colcnt) 'Redimension MyArray parameters to fit the SQL returned'
rst.MoveFirst

'Populating Array with Headers from Recordset'
For j = 0 To colcnt
     MyArray(0,j) = rst.Fields(j).name
Next

'Populating Array with Record Data
For i = 1 to rowcnt
    For j = 0 to colcnt
        MyArray(i,j) = rst(j)
    Next J
    rst.movenext
Next i

'---------------------------------WORKSHEET OUTPUT---------------------------------'
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Insert Worksheet Name")
Set Dest = ws.Range("A1") 'Destination Cell
Dest.Resize(UBound(MyArray, 1) + 1, UBound(MyArray, 2) + 1).value = 
Application.Transpose(MyArray) 'Resize (secret sauce)

End Sub