我怎样才能复制"使用microsoft vba从microsoft访问数据库查询excel电子表格?

时间:2018-01-09 20:47:33

标签: excel vba excel-vba ms-access

希望我提出的问题很明确,说实话,我也是使用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 :代码

编辑2 :当我尝试将SELECT * FROM更改为我之前使用的现有连接到我想要的数据库查询时,我再次使用该代码,它说了一些关于多值单元格的东西,而且无法从不同的数据库中获取数据。 (此工作表的连接以前用于制作自动表格,因此当数据库表格值发生变化时,电子表格就完成了。我现在尝试做的只是“复制并粘贴”使用宏,因为以前的方法不再可用,遗憾的是。

2 个答案:

答案 0 :(得分: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

enter image description here

答案 1 :(得分:0)

这段代码对我有用,它被剥光了,所以它可能无法完全编译:

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