Question

怎样用VBA取得Access数据库中的查询结果？

Dim MyDb As Database '定义数据库对象
Dim MyDs As Recordset '定义数据集对象
Dim CNN As Connection
Set MyDb = CurrentDb '数据库为当前数据库
Dim i As Integer
Set MyDs = MyDb.OpenRecordset("Select Flux_Amount FROM Mytable", , dbReadOnly)

Debug.Print MyDs.RecordCount

For i = 0 To MyDs.RecordCount - 1
MsgBox CStr(MyDs.Fields(0))
Next i

问题是Mytable中有64条记录，但是查询结果只显示了1条。

请问，怎么才能将这64条记录都取出，并通过VBA传递给一个数组A呢？

谢谢！
谢谢yuan710825，但是我的问题的重点是，将全部记录取出。表单中明明有64条记录，但是总是只能显示一条。Debug.Print MyDs.RecordCount显示的结果也是1.
请问，怎么解决呢？

Answer 1

对于这种写法不是很了解，如果用ado+sql可以帮到你。

Sub bb()

Dim cnn As ADODB.Connection

Dim rs As ADODB.Recordset

Set cnn = New ADODB.Connection

mydata = ThisWorkbook.Path & "\123.mdb"

With cnn

.Provider = "microsoft.jet.oledb.4.0"

.Open mydata

End With

Set rs = New ADODB.Recordset

Sql = "select Flux_Amount from Mytable"

rs.Open Sql, cnn, 3, 2

ReDim arr(rs.RecordCount)

For i = 0 To rs.RecordCount - 1

arr(i) = rs.Fields("Flux_Amount")

rs.MoveNext

Next i

MsgBox Join(arr, ",")

End Sub

应该说这种用法比较主流，复制代码到vbe，然后引用ado 2.8,将access与excel文件放在一个文件夹，将数据库名变动一下，就可以测试了。（要改为同你的access,表名，字段名一致）

Answer 2

用DAO，可以在VB添加DAO组件。然后，定义参数。

'Database Connection
Dim cn As Workspace
Dim db As Database
Dim Rs As Recordset
Dim YOURPWD$, strSQL$, sContent$

'设置数据库
Set cn = DBEngine.Workspaces(0)
Set db = cn.OpenDatabase(sDbPath, False, False, ";pwd=" & YOURPWD)

'打开数据库
strSQL = "Select * From YourTable"
Set Rs = db.OpenRecordset(strSQL, , dbReadOnly)

'取出一个不为NULL的字符串字段值
sContent = trim$(Rs!Item1)

--------------------------------------------------------------
'使用前提在VB中加入VB组件
Dim xlsApp As Object, xlsBook As Object, xlsSheet As Object
Dim Row&, Col&

On Error GoTo ExcelInport_Err
'创建应用Excel程序
Set xlsApp = CreateObject("Excel.Application")
'Excel WorkBook 的添加
Set xlsBook = xlsApp.Workbooks.Add
’取得活动的Excel Sheet
Set xlsSheet = xlsBook.ActiveSheet

'Excel Sheet的标题
xlsSheet.Name = "Your Sheet Name"

'Excel Sheet 内容的填充
With xlsSheet
Row = 1 '行
Col = 1 '列
.Cells(Row, Col).Value = "Your Fill Content"
End With

‘Excel
xlsApp.Visible = True

Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
Exit Sub

ExcelInport_Err:
'关闭时没有消息框
xlsApp.DisplayAlerts = False
xlsApp.Quit
Set xlsApp = Nothing

Answer 3

For i = 0 To MyDs.RecordCount - 1
MsgBox CStr(MyDs.Fields(0))
MyDs.movenext
Next i
你少了这句：“MyDs.movenext”记录向下移动。