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.

plain text version

VBA:

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

plain text version

VBA:

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