在Excel中查找Access数据库

我想做一件非常简单的事情：我有一个Access数据库，其中一个表将数千个产品ID映射到产品信息字段。 在Excel工作表中，用户在第一列中input大约100个产品ID。 我需要为剩余的列从Access数据库中获取相应ID的信息。 特别：

1. 如果我使用MS-Query，它似乎坚持输出是一个表。 我只是想要输出在一个单元格内。 最好是涉及SQLtypes查询的公式。
2. 我不希望任何值自动更新，而是希望只根据用户需求更新所有列（用户可以select通过菜单刷新，也可以select基于VBA的刷新button） ）。

我认为这将是一个简单的用例，但似乎很难find解决scheme。 先谢谢你！

Answer 1

从Excel工作，您可以使用ADO连接到数据库。 对于Access和Excel 2007/2010，您可能会：

''Reference: Microsoft ActiveX Data Objects xx Library Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset ''Not the best way to refer to a workbook, but convenient for ''testing. it is probably best to refer to the workbook by name. strFile = ActiveWorkbook.FullName ''Connection string for 2007/2010 strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _ & ";Extended Properties=""Excel 12.0 xml;HDR=Yes;"";" cn.Open strCon ''In-line connection string for MS Access scn = "[;DATABASE=Z:\Docs\Test.accdb]" ''SQL query string sSQL = "SELECT a.Stuff, b.ID, b.AText FROM [Sheet5$] a " _ & "INNER JOIN " & scn & ".table1 b " _ & "ON a.Stuff = b.AText" rs.Open sSQL, cn ''Write returned recordset to a worksheet ActiveWorkbook.Sheets("Sheet7").Cells(1, 1).CopyFromRecordset rs 

另一种可能性从MS Access返回单个字段。 这个例子使用了后期绑定，所以你不需要库引用。

 Dim cn As Object Dim rs As Object Dim strFile As String Dim strCon As String Dim strSQL As String Dim s As String Dim i As Integer, j As Integer strFile = "z:\docs\test.accdb" strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile ''Late binding, so no reference is needed Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") cn.Open strCon ''Select a field based on a numeric reference strSQL = "SELECT AText " _ & "FROM Table1 a " _ & "WHERE ID = " & Sheets("Sheet7").[A1] rs.Open strSQL, cn, 3, 3 Sheets("Sheet7").[B1] = rs!AText 

Answer 2

好吧，这可能看起来有点冗长 – 创build一个Excel表 – 在第一行（从第二列），你有字段名完全一样你在访问表中，在第一列你有所需的键值（例如CustomerIDs）。 当你运行这个macros时，它会填充它发现的东西。

 Sub RefreshData() Const fldNameCol = 2 'the column with the first fieldname in it' Dim db, rst As Object Set db = DBEngine.workspaces(0).OpenDatabase("C:\path\to\db\name.accdb") Set rst = db.openrecordset("myDBTable", dbOpenDynaset) Dim rng As Range Dim showfields() As Integer Dim i, aRow, aCol As Integer ReDim showfields(100) Set rng = Me.Cells aRow = 1 'if you have the fieldnames in the first row' aCol = fldNameCol '***** remove both '' to speed things up' 'On Error GoTo ExitRefreshData' 'Application.ScreenUpdating = False' '***** Get Fieldnames from Excel Sheet' Do For i = 0 To rst.fields.Count - 1 If rst.fields(i).Name = rng(aRow, aCol).Value Then showfields(aCol) = i + 1 Exit For End If Next aCol = aCol + 1 Loop Until IsEmpty(rng(aRow, aCol).Value) ReDim Preserve showfields(aCol - 1) '**** Get Data From Databasetable' aRow = 2 'startin in the second row' aCol = 1 'key values (ID) are in the first column of the excel sheet' Do rst.FindFirst "ID =" & CStr(rng(aRow, aCol).Value) 'Replace ID with the name of the key field' If Not rst.NoMatch Then For i = fldNameCol To UBound(showfields) If showfields(i) > 0 Then rng(aRow, i).Value = rst.fields(showfields(i) - 1).Value End If Next End If aRow = aRow + 1 Loop Until IsEmpty(rng(aRow, aCol).Value) ExitRefreshData: Application.ScreenUpdating = True On Error GoTo 0 End Sub 

如果你不希望你的excel表中的字段名replace段落“从excelsheet获取字段名”：

  fieldnames = Split("field1name", "", "", "field3name") For j = 0 To UBound(fieldnames) - 1 For i = 0 To rst.fields.Count - 1 If rst.fields(i).Name = fieldnames(j) Then showfields(j + fldNameCol) = i + 1 Exit For End If Next Next ReDim Preserve showfields(UBound(fieldnames) - 1 + fldNameCol) 

并将其添加到顶部

 dim j as integer dim fieldnames