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