检索记录集填充数组并输出到工作表

Question

这么多年过去了，我看到了几个问题，询问如何使用 Recordset 填充数组，但没有一个问题涉及如何在一个过程中将输出写入工作表。因此，我决定提出这个问题，以便提供我随着时间的推移得出的答案。

Answer 1

'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