Check Access table(s) from Excel using Automation

January 30, 2008 – 8:43 pm by JP

Finally, with some help from the good folks over in the microsoft.public.access.modulesdaovba newsgroup, I was able to complete my code to search an Access database for some information stored in an Excel worksheet.

This code will cycle through a list of numbers in column B, starting in cell B2, then check three tables in an Access file for a matching record. If it finds a match in the first table, it exits, otherwise it checks the second, then the third table (no need to keep going if we find a match right away). It prints "Found" or "Not Found", as appropriate, in the corresponding cell in column H. This is to accomodate my specific needs for this project at my office, but you could easily adjust this code to search for text or numbers in the Access db of your choice and put the response into the next column (instead of 6 columns away).

I got a pretty rough education in Access VBA coding; it took only a few minutes to write the code, but hours to search for the proper syntax to access the correct objects.

First you need to open each table and index the column you want to search. This is the "Column Header #" that contains the values you want to search through. Click on the table and go to 'Design View'. Select the field you want to index, and in the box at the bottom, click in the dropdown next to 'Index' and choose 'Yes (duplicates OK)'. Save and close and now you can use the Index property of the Recordset Object to specify that column to search for your values.

plain text version

VBA:

Sub FileCheck()
'
' Macro to search a column in an Access db table for text/values in column B, starting in cell B2
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Dir("C:\Folder\database.ldb") = "" Then
' If a .mdb file is open, a matching .ldb file with the same name is opened in the same directory
Dim CheckRng As Excel.Range
Dim cell As Excel.RangeActiveSheet.UsedRange
Set CheckRng = Range("B2", Range("B65536").End(xlUp))
For Each cell In CheckRng
If MatchAccessTables(cell.Value) Then
cell.Offset(0, 6).Value = "Found"
Else
cell.Offset(0, 6).Value = "Not Found"
End If
Next cell
Else
MsgBox ("Database file appears to be locked. Please try again later."), vbCritical
GoTo ExitProc
End If
ExitProc:
Set objDBEngine = Nothing
Set objWSP = Nothing
Set DAODB = Nothing
Set DAORS = Nothing
Set DAOTBL = Nothing
Set CheckRng = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub