Запустите запрос доступа из Excel и передайте параметры запроса

Question

Как выполнить запрос в MS Access DB из Excel VBA кода или макроса. Запрос MS-Access принимает некоторые параметры, которые необходимо передать из Excel. Спасибо

Answer 1

Вот одна из возможностей:

Dim cn As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String

strFile = "C:\docs\Test.mdb"

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile

''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")

cn.Open strCon

strSQL = "INSERT INTO ATable (AField) " _
& "VALUES (" & Sheet1.[A1] & ")"

cn.Execute strSQL

cn.Close
Set cn = Nothing

Вы также можете ссылаться в строке в sql на набор данных из Excel.

РЕДАКТИРОВАТЬ комментарии

Использованиекоманда:

strSQL = "SELECT * FROM ATable " _
& "WHERE AField = @AField"

With cmd
    Set .ActiveConnection = cn
    .CommandText = strSQL
    .CommandType = 1 'adCmdText

    ''ADO Datatypes are often very particular
    ''adSmallInt = 2 ; adParamInput = 1
    .Parameters.Append .CreateParameter("@AField", 2, 1, , Sheet1.[A1])

End With
Set rs = cmd.Execute 

См. также: http://support.microsoft.com/kb/181782

Answer 2

Используется ADODB.

Set m_Connection = New Connection

If Application.Version = "12.0" Then
    m_Connection.Provider = "Microsoft.ACE.OLEDB.12.0"
Else
    m_Connection.Provider = "Microsoft.Jet.OLEDB.4.0"
End If

m_Connection.Open <full path to Access DB>
If m_Connection.State > 0 Then

    Dim rsSource As New Recordset
    rsSource.Open strQuery, m_Connection, adOpenForwardOnly, adLockReadOnly

    Dim result As Long
    Dim rngTarget As Range
    rngTarget = ThisWorkbook.Worksheets(m_SheetName).Range("A1")

    If Not rsSource.BOF Then
        result = rngTarget.CopyFromRecordset(rsSource)
    End If

    If rsSource.State Then rsSource.Close
    Set rsSource = Nothing

End If

Таким образом, он запускает запрос и помещает его туда, куда вам нравится.strQuery - это имя запроса в БД или в строке SQL.