sql - Access データベースを Excel で検索する

Question

私は非常に単純なことをしたい: 何千もの製品 ID を製品情報フィールドにマッピングする 1 つのテーブルを持つ Access データベースがあります。Excel ワークシートでは、ユーザーは最初の列におそらく 100 個の製品 ID を入力します。残りの列で、Access データベースから対応する ID の情報を取得する必要があります。具体的には：

MS-Query を使用すると、出力がテーブルであることを主張しているようです。出力を単一のセル内に配置したいだけです。できれば、SQL タイプのクエリを含む数式。
値を自動的に更新するのではなく、すべての列をユーザーの要求に応じてのみ更新したい (ユーザーはメニューから更新を選択するか、シートの VBA ベースの更新ボタンでも問題ありません) ）。

これは簡単なユースケースだと思いますが、解決策を見つけるのは驚くほど難しいようです。前もって感謝します！

score 2 · Accepted Answer

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

もう 1 つの可能性は、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

score 1 · Accepted Answer

OK、これは少し長く思えるかもしれません - Excel テーブルを作成します - 最初の行 (列 2 から) には、アクセステーブルにあるのとまったく同じようにフィールド名があります。最初の列には、目的のキー値があります。 (例: 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

sql - Access データベースを Excel で検索する

2 に答える 2

Related

Reference