如何获得访问查询到excel vba作为范围

好吧，我有这个函数，它使用查询string查询数据库，我传递给它。 目前它在工作表中输出查询结果。 我如何获得函数给我的结果作为一个范围，我可以用VBA来执行计算等？ 那么我将如何参考这个范围？ 例如得到结果中的“名称”列。

Function Access_Data(query As String) 'Requires reference to Microsoft ActiveX Data Objects xx Library Dim Cn As ADODB.Connection, Rs As ADODB.Recordset Dim MyConn, sSQL As String Dim Rw As Long, Col As Long, c As Long Dim MyField, Location As Range 'Set destination Set Location = Sheets(1).Range("a1") 'Set source MyConn = "S:\Docs\Harry\Engine Client\Engine3.accdb" 'Create query sSQL = query 'Create RecordSet Set Cn = New ADODB.Connection With Cn .Provider = "Microsoft.ACE.OLEDB.12.0" .Open MyConn Set Rs = .Execute(sSQL) End With 'Write RecordSet to results area Rw = Location.Row Col = Location.Column c = Col Do Until Rs.EOF For Each MyField In Rs.Fields Cells(Rw, c) = MyField c = c + 1 Next MyField Rs.MoveNext Rw = Rw + 1 c = Col Loop Set Location = Nothing Set Cn = Nothing 

结束function

Answer 1

 Function Access_Data(query As String) 'Requires reference to Microsoft ActiveX Data Objects xx Library Dim Cn As ADODB.Connection, Rs As ADODB.Recordset Dim MyConn, sSQL As String Dim Rw As Long, c As Long Dim MyField, Result 'Set source MyConn = "S:\Docs\Harry\Engine Client\Engine3.accdb" 'Create query sSQL = query 'Create RecordSet Set Cn = New ADODB.Connection With Cn .Provider = "Microsoft.ACE.OLEDB.12.0" .CursorLocation = adUseClient .Open MyConn Set Rs = .Execute(sSQL) End With 'Write RecordSet to results Redim Result(1 To Rs.RecordCount, 1 To Rs.Fields.Count) Rw = 1 Do Until Rs.EOF c = 1 For Each MyField In Rs.Fields Result(Rw, c) = MyField c = c + 1 Next MyField Rs.MoveNext Rw = Rw + 1 Loop Set Cn = Nothing Access_Data = Result End Function 

这将返回一个multidimensional array。 范围必须引用工作表的某个部分：不能创build“不可见”范围。 （尽pipe你可以将工作表的一部分隐藏起来，如果这就是你所追求的。）

要访问结果：

 Dim v, i As Long v = Access_Data("select ID, Name from somewhere") For i = 1 To UBound(v, 1) MsgBox v(i, 1) & " / " & v(i, 2) Next 

Answer 2

示例如何从SQL Server读取数据并将结果插入工作表（这里使用集成安全性）。 如果在插入新数据之前目标工作表是空的，则使用UsedRange属性来引用它。 或者计算一下，rng是最左边的单元格。

 Option Explicit ' Add reference to Microsoft ActiveX Data Objects Lib Public Sub main(): On Error GoTo Err_handler Dim cn As ADODB.Connection Set cn = New ADODB.Connection cn.ConnectionString = "Provider=SQLOLEDB;Data Source=MYSUPERSERVER;Initial Catalog=MYSUPERDATABASE;Integrated Security=sspi" cn.Open Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset rs.ActiveConnection = cn rs.Open "SELECT * FROM MyTable" Dim fld As ADODB.Field Dim rng As Range Set rng = [a1] For Each fld In rs.Fields rng.Value = fld.Name Set rng = rng.Offset(0, 1) Next fld Set rng = rng.Offset(1, -rs.Fields.Count) rng.CopyFromRecordset rs rs.Close cn.Close Set rs = Nothing Set cn = Nothing Exit Sub Err_handler: MsgBox Err.Description End Sub