Запрос доступа из Excel. Ожидаемое имя запроса после выполнения

Question

Я пытаюсь написать какой-нибудь VBA для запроса базы данных Access и возврата значений на основе того, что находится в моей электронной таблице. Исходя из того, что я нашел в этом вопросе, вот что у меня есть:

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 только один раз, чтобы получить все данные в набор записей, затем используйте метод поиска набора записей.

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, и наоборот. Вот один простой способ извлечения данных в Excel из Access (код запускается в 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»

Здесь это другой, похожий, но другой способ импорта данных в Excel из Access.

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