Question

我想做一些非常简单的事情：我有一个Access数据库，其中一个表将数千个产品ID映射到产品信息字段。在Excel工作表中，用户可以在第一列中键入100个产品ID。我需要剩下的列从Access数据库中获取相应ID的信息。具体做法是：

如果我使用MS-Query，它似乎坚持输出是一个表。我只是希望输出在单个单元格内。优选地，涉及SQL类型查询的公式。
我不希望任何值自动更新，而是希望所有列仅根据用户需求更新（用户可以选择通过菜单刷新，或者工作表上基于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

好吧，这可能看起来有点冗长 - 创建一个Excel表 - 在第一行（从第二列开始）你拥有Fieldnames，就像你在access-table中一样，在第一列你有所需的键值（例如CustomerID）。运行宏时，它会填充它找到的内容......

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表格中的字段名称替换段落“从Excel表格中获取字段名称”，请执行以下操作：

  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

在Excel中查找Access数据库

2 个答案: