Hello, I'm trying to get a macro in Excel to import table from Access.
I have this working fully in ADO, but when I try DAO I keep getting a runtime error at the open database part and cannot see why.
Sub ImportTableDAO(lo As ListObject, strSource1 As String, strSource2 As String)
' DIM statements
Dim strMyPath As String, strDBName As String, strDB As String
Dim i As Long, n As Long, lFieldCount As Long, lWarnPeriod As Long
Dim rng As Range
' Instantiate and set ADO object database and recordset
Dim conn As DAO.Database
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
' Set database file location
strDBName = "Test.accdb" ' Database name
strMyPath = ThisWorkbook.Path ' Current workbook path
strDB = strMyPath & "\DB\" & strDBName ' Database full path and name
' Open connection with MS Access database
On Error GoTo ErrorConn
Set conn = DBEngine.Workspaces(0).OpenDatabase(strDB)
' Open recordset using source table/query
On Error GoTo ErrorRecordset
Set rst1 = conn.OpenRecordset(strSource1, dbOpenDynaset)
Set rst2 = conn.OpenRecordset(strSource2, dbOpenDynaset)
On Error GoTo 0
' CustomSub: Clears the Excel table object
ClearTable lo
' Set initial values
Set rng = lo.Range(1, 1) ' Set top left corner of table
lFieldCount = rst1.Fields.Count ' Set max columns
lWarnPeriod = 6 ' Set default warning period
' Copy recordset to Excel Table object and colour code
If rst1.RecordCount > 0 Then
For i = 0 To lFieldCount - 1
' Copy column names in first row of the worksheet
rng.Offset(0, i).Value = rst1.Fields(i).Name
rst1.MoveFirst
rst2.MoveFirst
If IsNumeric(rng.Offset(-1, i).Value) Then _
lWarnPeriod = rng.Offset(-1, i).Value
n = 1 ' Copy record values starting from second row from initial range
Do While Not rst1.EOF
rng.Offset(n, i).Value = rst1.Fields(i).Value
If i >= 4 Then
' CustomFunction: Change cell colour dependant on value
ColourCodeStyle rng.Offset(n, i), rst2.Fields(i).Value, lWarnPeriod
ElseIf i >= 2 Then
' CustomFunction: Change cell colour dependant on value
ColourCodeStyle rng.Offset(n, i), True, lWarnPeriod
End If
rst1.MoveNext
rst2.MoveNext
n = n + 1
Loop
Next i
End If
' Close the objects
rst2.Close
rst1.Close
conn.Close
' Destroy the variables
Set rst2 = Nothing
Set rst1 = Nothing
Set conn = Nothing
' Run custom made subs
InsertSubHeadings lo ' Add sub headings rows to the table object
SortTableDefault lo ' Sort the table object in a specified order
Exit Sub
ErrorConn:
Debug.Print "Error with DAODB connection"
Exit Sub
ErrorRecordset:
Debug.Print "Error with DAORecordSet"
Exit Sub
End Sub
Bookmarks