Check Access table(s) from Excel using Automation - Updated Code

January 31, 2008 – 3:01 pm by JP

Here is the revised and completed code that I posted yesterday. The DAO declarations are moved outside the Sub procedure and the ‘Set’ statements are outside the function loop. Also, the table & column headers are now passed as arguments to the function, making the code more compact. The speed increase over yesterday’s code is significant.


Option Explicit
Dim DAODB As DAO.Database
Dim DAORS As DAO.Recordset
Dim objDBEngine As DAO.DBEngine
Dim objWSP As DAO.Workspace

Sub DDFileReconcile
'
' Macro to search Access db "dB" for values in an Excel worksheet
' Values/text should be in column B, starting in cell B2, result of search is placed in H2
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Dir("C:\dB.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.Range

  ActiveSheet.UsedRange 

  Set CheckRng = Range("B2", Range("B65536").End(xlUp))
  Set objDBEngine = New DAO.DBEngine
  Set objWSP = objDBEngine.Workspaces(0)
  Set DAODB = objWSP.OpenDatabase("C:\dB.ldb")

  For Each cell In CheckRng
    If MatchAccessTables(cell.Value, "table 1", "Indexed Column Header 1") Then
      cell.Offset(0, 6).Value = "Found"
    ElseIf MatchAccessTables(cell.Value, "table 2", "Indexed Column Header 2") Then
      cell.Offset(0, 6).Value = "Found"
    ElseIf MatchAccessTables(cell.Value, "table 3", "Indexed Column Header 3") 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 CheckRng = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Function MatchAccessTables(cell As String, TableName As String, ColToSearch As String) As Boolean

MatchAccessTables = False

Set DAORS = DAODB.OpenRecordset(TableName, dbOpenTable)
DAORS.Index = ColToSearch
DAORS.Seek "=", cell

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

End Function

Enjoy,
JP

If you enjoyed this page, share it!