怎样把access里的一个表里的三个字段下的数据全部付到一个两维数组里！再把数组里的数放到EXCEL

Question

用ADODB.Recordset.GetString()即可以复制到数组中了（用“，”作字段分割）
写成以文本文件即可以Excel打开

Answer 1

Public Sub GetStringX()     ' connection variables
    Dim Cnxn As ADODB.Connection
    Dim rstAuthors As ADODB.Recordset
    Dim strCnxn As String
    Dim strSQLAuthors As String
    Dim varOutput As Variant
    
     ' specific variables
    Dim strPrompt As String
    Dim strState As String
    
     ' open connection
    Set Cnxn = New ADODB.Connection
    strCnxn = "Provider=sqloledb;Data Source=MyServer;Initial Catalog=Pubs;User Id=sa;Password=; "
    Cnxn.Open strCnxn
    
     ' get user input
    strPrompt = "Enter a state (CA, IN, KS, MD, MI, OR, TN, UT): "
    strState = Trim(InputBox(strPrompt, "GetString Example"))
     
     ' open recordset
    Set rstAuthors = New ADODB.Recordset
    strSQLAuthors = "SELECT au_fname, au_lname, address, city FROM Authors " & _
                "WHERE state = '" & strState & "'"
    rstAuthors.Open strSQLAuthors, Cnxn, adOpenStatic, adLockReadOnly, adCmdText
    
    If Not rstAuthors.EOF Then
    ' Use all defaults: get all rows, TAB as column delimiter,
    ' CARRIAGE RETURN as row delimiter, EMPTY-string as null delimiter
       varOutput = rstAuthors.GetString(adClipString)
        ' print output
       Debug.Print "State = '" & strState & "'"
       Debug.Print "Name             Address             City" & vbCr
       Debug.Print varOutput
    Else
       Debug.Print "No rows found for state = '" & strState & "'" & vbCr
    End If
    
     ' clean up
    rstAuthors.Close
    Cnxn.Close
    Set rstAuthors = Nothing
    Set Cnxn = Nothing
        
End Sub

Answer 2

'从ACCESS里读到二维数组，很简单，下面的东西没有调试Dim adoConnection As ADODB.Connection
Set adoRs = New ADODB.Recordset
adoRs.CursorLocation = adUseClient
sConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                 & "Data Source=" & GetDBPath() 
adoConnection.Open sConnectionString
adCmdText = "SELECT * FORM xxxx" '你的查询语句
adoRs.Open sSql, adoConnection, , , adCmdText
adoRs.MoveFirst
iRows = adoRs.RecordCount
iCols = adoRs.Fields.CountReDim MyArray(0 To iRows, 0 To iCols) As VariantFor iRowLoop = 0 To iRows - 1
  For iColLoop = 0 To iCols - 1
     MyArray(iRowLoop, iColLoop) = adoRs.Fields(iColLoop)
  Next
  adoRs.MoveNext
Next'上面的代码就可以把字段值读到二维数组里，
'    我拿原来的代码改的，没有调试'用下面的函数把两维数组传到Excel
'下面的方法比较狠，也可以通过剪贴板往Excel单元格里写东西，不过慢
'对EXCEL XP须在宏安全性中启用信任对VB项目的访问。
Public Sub SendFunctionThenCallIt(GetRowsArray As Variant)
    'GetRowsArray is a GetRows style 2-D array (Col,Row)
    'Write function to an Excel module and then call it:    Dim ExcelApp As Excel.Application
    Dim WkBook As Excel.Workbook
    Dim WkSheet As Excel.Worksheet
    Dim sFn As String    sFn = "Public Function ShowRows(V As Variant, WkSheet As Worksheet)" & vbCrLf & _
    "    Dim Row&, Col&, FirstCol&, LastCol&, " & _
    "FirstRow&" & vbCrLf & _
    "   Cells.Select" & vbCrLf & _
    "   Selection.NumberFormat = " & Chr(34) & _
    "@" & Chr(34) & vbCrLf & _
    "   FirstRow = LBound(V, 2)" & vbCrLf & _
    "   FirstCol = LBound(V)" & vbCrLf & _
    "   LastCol = UBound(V)" & vbCrLf & _
    "   For Row = FirstRow To UBound(V, 2)" & vbCrLf & _
    "       For Col = FirstCol To LastCol" & vbCrLf & _
    "           If Not IsError(V(Col, Row)) Then " & _
    "WkSheet.Cells(Row + 1, Col + 1) = V(Col, Row) " & _
    " & vbNullString" & vbCrLf & _
    "       Next" & vbCrLf & _
    "   Next" & vbCrLf & _
    "End Function"    Set ExcelApp = New Excel.Application
    Set WkBook = ExcelApp.Workbooks.Add
    Set WkSheet = ExcelApp.Worksheets(1)
    WkSheet.Activate    WkBook.VBProject.VBComponents(1).CodeModule. _
        AddFromString sFn
    ExcelApp.Run "ThisWorkbook.ShowRows", _
        GetRowsArray, WkSheet
    ExcelApp.Visible = True
End Sub'如下面这样用
SendFunctionThenCallIt MyArray