Home » excel » sql – Looking up Access database in Excel

sql – Looking up Access database in Excel

Posted by: admin May 14, 2020 Leave a comment


I want to do something very simple: I have an Access database with one table mapping thousands of product IDs to product information fields. In an Excel worksheet, the user types in perhaps 100 product IDs in the first column. I need for the remaining columns to pull in information from the Access database for the corresponding IDs. Specifically:

  1. if I use MS-Query, it seems to insist on the output being a table. I simply want the output to be inside a single cell. Preferably, a formula that involves a SQL-type query.
  2. I don’t want any of the values to be updated automatically, but rather want all the columns updated only on user demand (the user could either choose refresh through a menu, or a VBA-based refresh button on the sheet is fine as well).

I’m thinking this would be a straightforward use case, but it seems surprisingly hard to find a solution. Thank you in advance!

How to&Answers:

Working from Excel, you can use ADO to connect to a database. For Access and Excel 2007/2010, you might:

''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

Another possibility returns a single field from MS Access. This example uses late binding, so you do not need a library reference.

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


OK, this may seem a bit lengthy – Create an Excel-table – in the first row (from column two) you have the Fieldnames Exactly as you have them in the access-table, in the first column you have the desired key-values (e.g. CustomerIDs).
When you run the macro it fills in what it finds…

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'
    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
    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'
    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
    End If
    aRow = aRow + 1
  Loop Until IsEmpty(rng(aRow, aCol).Value)

  Application.ScreenUpdating = True
  On Error GoTo 0
End Sub

And if you dont want your fieldnames in the excel sheet replace the paragraph “Get Fieldnames From Excelsheet” with this:

  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
  ReDim Preserve showfields(UBound(fieldnames) - 1 + fldNameCol)

and add this at the top

dim j as integer
dim fieldnames