在Excel中查找Access数据库

Question

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

1. 如果我使用MS-Query，它似乎坚持输出是一个表。我只是希望输出在一个单元格内。最好是涉及SQL类型查询的公式。
2. 我不希望任何值自动更新，而是希望只根据用户需求更新所有列（用户可以选择通过菜单刷新，或者工作表上的基于VBA的刷新按钮是也很好）。

我在想这将是一个简单的用例，但似乎很难找到解决方案。先谢谢你！

Answer 1

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

''Reference: Microsoft ActiveX Data Objects x.x 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

OK，这可能看起来有点冗长 - 创建一个Excel表 - 第一排（从两个列）在你的FIELDNAMES正是因为你有他们在访问表，在第一列你有所需的键值（例如CustomerIDs）。 当你运行这个它在它发现填补了宏...

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工作表中字段名更换款“获取FIELDNAMES从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