1

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

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

我认为这将是一个简单的用例，但似乎很难找到解决方案。先感谢您！

4

2 回答 2

2

在 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
于 2012-06-24T21:17:28.803 回答
1

好的，这可能看起来有点冗长 - 创建一个 Excel 表 - 在第一行（从第二列开始）你有字段名，就像你在访问表中一样，在第一列你有所需的键值（例如客户 ID）。当您运行宏时，它会填写找到的内容...

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
于 2012-06-24T22:23:35.417 回答