Question

我正在尝试查询Access数据库并根据电子表格中的内容返回值。

基于Running an Access Query from Excel，这是我所拥有的：

Sub testdb()

Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim prm As ADODB.Parameter
Dim rs As ADODB.Recordset

Set con = New ADODB.Connection
Set cmd = New ADODB.Command

With con
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Open "D:\Users\*****\Documents\Database2.accdb"
End With

With cmd
    .ActiveConnection = con
    .CommandText = "SELECT qx FROM Table1 WHERE ID = [MyID]; "
    .CommandType = adCmdStoredProc

    .Parameters.Append cmd.CreateParameter("MyID", adChar, adParamInput, Size:=14)
    .Parameters("MyID") = "ANBMaleNS21216"
End With

Set rs = New ADODB.Recordset
rs.Open cmd

Do Until rs.EOF
    Debug.Print rs.Fields("ID").Value
    rs.MoveNext
Loop

rs.Close
con.Close

Set cmd = Nothing
Set rs = Nothing
Set prm = Nothing
Set con = Nothing

End Sub

到达rs.Open cmd行时会出错

“运行时错误'-2147217900（80040e14）”：
执行后需要查询名称。

Answer 1

如果您要查找的只是一个相关值，并且真的不需要一整套数据，请考虑：

Dim acc As Access.Application, varData As Variant
Set acc = CreateObject("Access.Application")
acc.OpenCurrentDatabase ("D:\Users\*****\Documents\Database2.accdb")
'code here to start worksheet loop
varData = acc.DLookup("qx", "Table1", "ID=" & need worksheet cell reference here)
Debug.Print IIf(IsNull(varData), "Not found", varData)
'end worksheet loop here

或者更好的办法是只访问一次Access文件，以将所有数据拉入一个记录集，然后使用记录集的Find方法。

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\Users\*****\Documents\Database2.accdb"
rs.Open "SELECT qx FROM Table1", cn, adOpenDynamic, adLockPessimistic
'code here to start worksheet loop
rs.MoveFirst
rs.Find "ID=" & need worksheet cell reference here
Debug.Print IIf(rs.EOF, "Not found", rs!qx)
'end worksheet loop here

第二种方法实际上可能是更快的过程。

Answer 2

使用Excel控制MS Access的方法有很多，反之亦然。这是从Access（在Excel中运行代码）将数据提取到Excel中的一种简单方法。

Sub Import()
' Declare the QueryTable object
Dim qt As QueryTable
' Set up the SQL Statement
sqlstring = "Select LastName, FirstName from Employees Where FirstName In " & Range("A1:A10").Value & ""
' Set up the connection string, reference an ODBC connection
connstring = _
"ODBC;DSN=Northwind;UID=;PWD=;Database=Northwind"
' Now implement the connection, run the Query, and add
' the results to the spreadsheet starting at row A1
With ActiveSheet.QueryTables.Add(Connection:=connstring, Destination:=Range("A1"), Sql:=sqlstring)
.Refresh
End With
End Sub

注意：设置对“ Microsoft ActiveX数据对象2.8库”的引用

这是从Access导入数据到Excel的另一种相似但不同的方法。

Sub Select_From_Access()
    Dim cn As Object, rs As Object
    Dim intColIndex As Integer
    Dim DBFullName As String
    Dim TargetRange As Range

    DBFullName = "C:\your_path\Northwind.mdb"

    'On Error GoTo Whoa

    Application.ScreenUpdating = False

    Set TargetRange = Sheets("Select").Range("A1")

    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"

    Set rs = CreateObject("ADODB.Recordset")
    rs.Open "SELECT * FROM [OrderDetails] WHERE [OrderID] = 10248", cn, , , adCmdText

    ' Write the field names
    For intColIndex = 0 To rs.Fields.Count - 1
    TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
    Next

    ' Write recordset
    TargetRange.Offset(1, 0).CopyFromRecordset rs

    Application.ScreenUpdating = True
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    On Error GoTo 0
    Exit Sub

End Sub

从Excel查询访问。执行后的预期查询名称

2 个答案: