希望我提出的问题很明确,说实话,我也是使用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更改为我之前使用的现有连接到我想要的数据库查询时,我再次使用该代码,它说了一些关于多值单元格的东西,而且无法从不同的数据库中获取数据。 (此工作表的连接以前用于制作自动表格,因此当数据库表格值发生变化时,电子表格就完成了。我现在尝试做的只是“复制并粘贴”使用宏,因为以前的方法不再可用,遗憾的是。
答案 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
答案 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