Check Access table(s) from Excel using Automation

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.

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

Function MatchAccessTables(cell As String) As Boolean

MatchAccessTables = False

Dim DAODB As DAO.Database
Dim DAORS As DAO.Recordset
Dim DAOTBL As DAO.TableDef
Dim objDBEngine As DAO.DBEngine
Dim objWSP As DAO.Workspace

Set objDBEngine = New DAO.DBEngine
Set objWSP = objDBEngine.Workspaces(0)
Set DAODB = objWSP.OpenDatabase("C:\Folder\database.mdb ")

Set DAORS = DAODB.OpenRecordset("Table 1", dbOpenTable)
Set DAOTBL = DAODB.TableDefs("Table 1")
Set DAORS = DAOTBL.OpenRecordset(dbOpenTable)
DAORS.Index = "Column Header 1"
DAORS.Seek "=", cell

If DAORS.NoMatch = False Then
  MatchAccessTables = True
  Exit Function
Else
  Set DAORS = DAODB.OpenRecordset("Table 2", dbOpenTable)
  Set DAOTBL = DAODB.TableDefs("Table 2")
  Set DAORS = DAOTBL.OpenRecordset(dbOpenTable)
  DAORS.Index = "Column Header 2"
  DAORS.Seek "=", cell
End If

If DAORS.NoMatch = False Then
  MatchAccessTables = True
  Exit Function
Else
  Set DAORS = DAODB.OpenRecordset("Table 3", dbOpenTable)
  Set DAOTBL = DAODB.TableDefs("Table 3")
  Set DAORS = DAOTBL.OpenRecordset(dbOpenTable)
  DAORS.Index = "Column Header 3"
  DAORS.Seek "=", cell
End If

If DAORS.NoMatch = False Then
  MatchAccessTables = True
End If

End Function

Make sure you set a reference to 'Microsoft DAO 3.6 Object Library' before using this code.

Enjoy,
JP

Acknowledgments: microsoft.public.access.modulesdaovba