【VBA使用SQL读取数据并将结果转为数组】

Option Explicit
Sub test()
Dim db_xls, sql, arr
db_xls = ThisWorkbook.FullName
sql = "select * from [sheet1$] where 1 "
arr = db_sql_to_arr(db_xls, sql)
Sheets("sheet2").Cells.Clear
Sheets("sheet2").Cells(1, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub

Function db_sql_to_arr(db_xls, sql)
Dim conn_s, i, j, arr
Dim conn, rs As Object
Application.ScreenUpdating = False
Set conn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
conn_s = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & db_xls & ";"
If InStr(LCase(db_xls), ".xls") > 0 Then conn_s = conn_s & "Extended Properties='Excel 12.0';"
conn.Open conn_s
rs.Open sql, conn, 1, 1
Debug.Print rs.RecordCount, rs.Fields.Count
ReDim arr(1 To 1, 1 To rs.Fields.Count)
If rs.RecordCount > 0 Then
    'arr = Application.Transpose(rs.GetRows()) '65536限制
    ReDim arr(1 To rs.RecordCount, 1 To rs.Fields.Count)
    rs.MoveFirst
    For i = 1 To rs.RecordCount
        For j = 1 To rs.Fields.Count
            arr(i, j) = rs(j - 1)
        Next
        rs.MoveNext
    Next
End If
rs.Close
conn.Close
db_sql_to_arr = arr
Set rs = Nothing: Set conn = Nothing
Application.ScreenUpdating = True
End Function