如何使用microsoft vba将查询从microsoft access数据库“复制”到excel电子表格中？

Question

希望我问的问题很清楚，老实说，我对使用 Microsoft VBA 也很陌生（实际上是从今天开始尝试使用它）。我正在尝试从 Microsoft Access 数据库中“获取”一个查询/数据表，但我很难理解语法以及命令的确切作用。目前看来我正在进入查询，但只返回带有代码的数据表的第一个单元格：

Private Sub Select_From_Access()
Dim cn As Object
Dim rs As Object
Dim strSql As String
Dim strConnection As String
Dim placementRange As Range

'DescriptionErrorByLot is the worksheet I want to put the table in, the range A1:Z44 is what would hypothetically be cleared
'if it needed to be once there is data there and needs to be updated
Worksheets("DescriptionErrorByLot").Range("A1:Z44").ClearContents

Set cn = CreateObject("ADODB.Connection")

'This is where I want the query (table) to be placed?
Set placementRange = Worksheets("DescriptionErrorByLot").Range("A1")

'Connection string containing provider and file path to the database
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=C:\Users\sjevne\Desktop\Database.accdb"

'Selecting the whole table from the query "jc_C2ComplaintCountbyLot10"? This is the queries name in the database
'To better explain what I'm talking about, there's buttons I can click on in the access database inside of the
'Reports section (click 'Reports' button) and then I click another button "Description errors by lot" and then
'A table/query with the name jc_C2ComplaintCountbyLot10 is open

strSql = "SELECT * FROM jc_C2ComplaintCountByLot10;"

cn.Open strConnection

Set rs = cn.Execute(strSql)

placementRange.CopyFromRecordset rs

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

基本上我现在想知道的是，实际上是什么让我能够返回我感兴趣的数据表中的第一个单元格？显然，我怎样才能扩大范围以抓住整个东西？ 任何帮助将非常感激！提前致谢。

编辑 1：代码

EDIT 2 ：当我尝试将 SELECT * FROM 更改为我之前使用的现有连接到我想要的数据库查询时，我一直在玩代码，并且它说了一些关于多值单元格的内容，并且无法从不同的数据库中获取数据。 （此与工作表的连接以前用于创建自动表，因此当数据库表值发生更改时，电子表格会更改。我现在要做的只是使用宏“复制和粘贴”，因为以前的方法不是可悲的是，不再可用。

Answer 1

这是抓取整个表格的类似内容，我没有引入它们已经存在的字段名称。当您执行此操作时，不要忘记 ID 将与表字段数据一起提供。

Private Sub getDataTable_Click()
    Dim conn As Object ' connection
    Dim rs As Object 'record set
    Dim strSql As String
    Dim strConnection As String
    Dim placementRange As Range

'如果您想在复制前清除，请为您的工作表和范围更新此内容

Worksheets("mtrInteraction").Range("I2:P25").ClearContents

    Set conn = CreateObject("ADODB.Connection")

    'update this for the workbook,worksheet, and range where you want it

'为表格和你想要桌子的范围更新这个，左上角

Set placementRange = Worksheets("mtrInteraction").Range("I2")

'更新您的路径和数据库名称

'Build your connection and path
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=C:\yourpath\yourpath\updatethis.accdb"

'为您的查询更新此内容，您只需更改表名即可复制整个表，在上面的连接中指定了数据库名称

'让你的 sql 查询从你的表名中全选

strSql = "SELECT * FROM tbl_MTR;"

    'open it you might want an error handler here
    conn.Open strConnection

    'get the recordset
    Set rs = conn.Execute(strSql)

    'copy your recordset in
    placementRange.CopyFromRecordset rs

    rs.Close
    Set rs = Nothing
    conn.Close
    Set conn = Nothing

End Sub

以下是存根中的相同内容，其中包含您想要的字段名称和用于特定定位的单元格中的数据值：

Private Sub CommandButton1_Click()
Dim inputSheet As Worksheet
Dim fieldSTR As String
Dim placementRange As Range

Dim rs As Object 'record set

Dim conn As Object
Dim strQuery As String

Dim myDB As String

Set inputSheet = ThisWorkbook.Worksheets("Sheet1")
Set placementRange = inputSheet.Range("E2")

fieldSTR = CStr(inputSheet.Cells(3, 3).Value) 'C3 cell
myDB = "C:\yourpath\yourpath\updatethis.accdb"

Set conn = CreateObject("ADODB.Connection")

    With conn
        .Provider = "Microsoft.ACE.OLEDB.12.0"    'For *.ACCDB Databases
        .ConnectionString = myDB
        .Open
    End With


strQuery = "SELECT * FROM " & _
            "tbl_test WHERE Color = " & "'" & fieldSTR & "'" & ";"

'The below gives the same result as * but you could limit the fields returned as well
'tbl_test.ID, tbl_test.Color, tbl_test.number

MsgBox (strQuery)

Set rs = conn.Execute(strQuery)

placementRange.CopyFromRecordset rs

rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing

End Sub

Answer 2

这段代码对我有用，它被剥离了，所以它可能无法干净地编译：

Sub LoadRecordset(Sheet1 As Worksheet, query As String)
    Dim cnpubs As ADODB.Connection
    Dim rsPubs As ADODB.Recordset

    Set cnpubs = New ADODB.Connection
    cnpubs.ConnectionString = "Driver={SQL Server};Server=TESTDS;Database=TEST1;UID=sa;PWD=WERQEWDS"
    cnpubs.Open

    Set rsPubs = New ADODB.Recordset

    With rsPubs
        .ActiveConnection = cnpubs
        .Open query
        fldCount = .Fields.Count
        iRow = 1
        Sheet1.Rows(iRow & ":" & Rows.Count).Delete
        For iCol = 0 To fldCount - 1
            Sheet1.Cells(iRow, iCol + 1).Value = .Fields(iCol).Name
        Next
        iRow = iRow + 1
        Sheet1.Range("A" & iRow).CopyFromRecordset rsPubs
        .Close
    End With
    cnpubs.Close
    Set rsPubs = Nothing
    Set cnpubs = Nothing

   Sheet1.Cells.EntireColumn.AutoFit
End Sub