Looking up Access database in Excel - sql

Question

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:
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.
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!

Answer 1

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

Answer 2

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'
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
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
Next
Next
ReDim Preserve showfields(UBound(fieldnames) - 1 + fldNameCol)
and add this at the top
dim j as integer
dim fieldnames