将数据从 excel 发送到访问、运行查询、将查询结果发送回 excel

Question

所以基本上我希望能够从 excel 发送日期以进行访问，运行一些查询，并将结果发送回 excel，并通过 excel VBA 完成所有这些操作。

我想将我的数据（位于工作表名称为“Enrollment Data Aggregate”的 Excel 工作表中）发送到访问数据库 H:\My file extension\Nameofdatabase.accdb 并将其另存为名称为“Enrollment”的表数据聚合”。

我已经有从“注册数据聚合”表运行的查询放在一起，所以我认为（希望）我可以删除该表，当我从 excel 中拉入新表时，查询仍会更新。然后我想访问运行/更新查询并将它们作为单独的选项卡导出到我的 excel 文件中。

理想情况下，我想继续在 Excel VBA 中做其他事情。换句话说，我真的希望我可以从 excel 中控制所有这些。我在 excel 和 access 方面有丰富的经验，但我只做过大约 4 个像这样大的 VBA 项目（我做过很多小宏），所以我不是很有经验。任何建议将不胜感激。

Answer 1

要将数据从 Excel 导出到 Access：

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\FolderName\DataBaseName.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable  
    ' all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

将数据从 Access 导入 Excel：

Sub ADOImportFromAccessTable(DBFullName As String, _
    TableName As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
    "TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
    Set TargetRange = TargetRange.Cells(1, 1)
    ' open the database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
        DBFullName & ";"
    Set rs = New ADODB.Recordset
    With rs
        ' open the recordset
        .Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable 
        ' all records
        '.Open "SELECT * FROM " & TableName & _
            " WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText 
        ' filter records

        RS2WS rs, TargetRange ' write data from the recordset to the worksheet

'        ' optional approach for Excel 2000 or later (RS2WS is not necessary)
'        For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
'            TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
'        Next
'        TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data

    End With
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

从 Excel 运行 Access 查询：

Sub CreateAndRunQuery()

    '------------------------------------------------------------------------------------------
    'This macro opens the Sample.accdb database, creates and runs an SQL query (filtering
    'all the customers from Canada). Then, it copies selected fields back in the Excel sheet.
    'The code uses late binding, so no reference to external library is required.

    'Written By:    Christos Samaras
    'Date:          05/10/2013
    'Last Updated:  29/11/2014
    'E-mail:        xristos.samaras@gmail.com
    'Site:          http://www.myengineeringworld.net
    '------------------------------------------------------------------------------------------

    'Declaring the necessary variables.
    Dim con         As Object
    Dim rs          As Object
    Dim AccessFile  As String
    Dim strTable    As String
    Dim SQL         As String
    Dim i           As Integer

    'Disable screen flickering.
    Application.ScreenUpdating = False

    'Specify the file path of the accdb file. You can also use the full path of the file like:
    'AccessFile = "C:\Users\Christos\Desktop\Sample.accdb"
    AccessFile = ThisWorkbook.Path & "\" & "Sample.accdb"

    'Set the name of the table you want to retrieve the data.
    strTable = "Customers"

    On Error Resume Next
    'Create the ADODB connection object.
    Set con = CreateObject("ADODB.connection")
    'Check if the object was created.
    If Err.Number <> 0 Then
        MsgBox "Connection was not created!", vbCritical, "Connection Error"
        Exit Sub
    End If
    On Error GoTo 0

    'Open the connection.
    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile

    'Create the SQL statement to retrieve the data from table.
    'Get the necessary information (first name etc.) for all the Canadian customers.
    SQL = "SELECT FirstName, LastName, Address, City, Phone FROM " & strTable & " WHERE COUNTRY='Canada'"

    On Error Resume Next
    'Create the ADODB recordset object.
    Set rs = CreateObject("ADODB.Recordset")
    'Check if the object was created.
    If Err.Number <> 0 Then
        'Error! Release the objects and exit.
        Set rs = Nothing
        Set con = Nothing
        'Display an error message to the user.
        MsgBox "Recordset was not created!", vbCritical, "Recordset Error"
        Exit Sub
    End If
    On Error GoTo 0

    'Set thee cursor location.
    rs.CursorLocation = 3 'adUseClient on early  binding
    rs.CursorType = 1 'adOpenKeyset on early  binding

    'Open the recordset.
    rs.Open SQL, con

    'Check if the recordet is empty.
    If rs.EOF And rs.BOF Then
        'Close the recordet and the connection.
        rs.Close
        con.Close
        'Release the objects.
        Set rs = Nothing
        Set con = Nothing
        'Enable the screen.
        Application.ScreenUpdating = True
        'In case of an empty recordset display an error.
        MsgBox "There are no records in the recordset!", vbCritical, "No Records"
        Exit Sub
    End If

    'Copy the recordset headers.
    For i = 0 To rs.Fields.Count - 1
        Sheets("New Query").Cells(1, i + 1) = rs.Fields(i).Name
    Next i

    'Write the query values in the sheet.
    Sheets("New Query").Range("A2").CopyFromRecordset rs

    'Close the recordet and the connection.
    rs.Close
    con.Close

    'Release the objects.
    Set rs = Nothing
    Set con = Nothing

    'Adjust the columns' width.
    Sheets("New Query").Columns("A:E").AutoFit

    'Enable the screen.
    Application.ScreenUpdating = True

    'Inform the user that the macro was executed successfully.
    MsgBox "The Canadian customers were successfully retrieved from the '" & strTable & "' table!", vbInformation, "Done"

End Sub

您将在此处找到更多信息。

http://www.myengineeringworld.net/2013/10/running-access-queries-from-excel-vba.html