• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 605
  • Last Modified:

Using ADO, loop through an Access database noting Table Names and Record Counts

I can do this using DAO but not ADO, and I prefer doing it with ADO.  I want to go through an existing Access database, grab each table name and a count of its records, and then export that data to an Excel sheet.

I've included the incomplete code that I'm using.  I'm having trouble with:

1) Actually looping through each table, the code there is very incomplete
2) Properly writing the data to Excel using ADO
3) I'm not sure I've even created the Excel sheet correctly using ADO    

Any feedback, help, and/or corrections would be greatly appreciated.
  Dim cnn As ADODB.Connection
  Dim rst As ADODB.Recordset
  Dim sSQL As String
  Dim iTable as Integer
 Excel Variables
  Dim xlApp As Object
  Dim xlWb As Object
  Dim xlWs As Object
 Create an instance of Excel and add a workbook
  Set xlApp = CreateObject("Excel.Application")
  Set xlWb = xlApp.Workbooks.Add
  Set xlWs = xlWb.Worksheets("Sheet1")
 Display Excel and give the user control of Excels lifetime
  xlApp.Visible = True
  xlApp.UserControl = True
  Set cnn = CurrentProject.Connection
  Set rst = New ADODB.Recordset
  iTable = 1
  For Each Table in the Database that doest start with "~" or "MSYS"
    sSQL = "SELECT Count(*) As TotalRecords FROM " & DatabaseTable
    rst.Open sSQL, cnn, adOpenStatic, adLockOptimistic
    xlWs.Cells(iTable, 1).Value = the Table Name (in Column A)
    xlWs.Cells(iTable, 2).Value = the the Number of Records (rst!TotalRecords, in Column B)
    iTable = iTable + 1
  Next Table
  Set rst = Nothing
  Set cnn = Nothing
  Set xlWs = Nothing
  Set xlWb = Nothing
  Set xlApp = Nothing

Open in new window

  • 6
  • 5
1 Solution
Below you can find a function which you can call to get all your tablenames

dim tables as string()
tables = GetTablesADO("YourDatabase")
for i = 0 to tables.ubound
    sSQL = "SELECT Count(*) As TotalRecords FROM " & tables(i)
    rst.Open sSQL, cnn, adOpenStatic, adLockOptimistic
    xlWs.Cells(iTable, 1).Value = the Table Name (in Column A)
    xlWs.Cells(iTable, 2).Value = the the Number of Records (rst!TotalRecords, in Column B)
    iTable = iTable + 1
  Next Table

Private Function GetTablesADO(strDatabase As String) As String()
On Error GoTo Hell
'Temp storage of the Table names
Dim retVal() As String
ReDim retVal(0) As String
'Create a Connection
Dim CNN As Connection
Set CNN = New Connection
CNN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDatabase
' Open the tables schema rowset
Dim RS As Recordset
Set RS = CNN.OpenSchema(adSchemaTables)
'Create a field object to bind to the
' TABLE_NAME field
Dim oField As Field
Set oField = RS.Fields("TABLE_NAME")
'Loop through the results add to the array
Do Until RS.EOF
    'Check for a user table object
    If RS.Fields("TABLE_TYPE") = "TABLE" Then
        retVal(UBound(retVal)) = oField.Value
        'Make room for another item in the array
        ReDim Preserve retVal(UBound(retVal) + 1)
    End If
'Strip off the last item in the array
ReDim Preserve retVal(UBound(retVal) - 1)
'Return the array
GetTablesADO = retVal
    Set oField = Nothing
    If RS.State = adStateOpen Then RS.Close
    Set RS = Nothing
    If CNN.State = adStateOpen Then CNN.Close
    Set CNN = Nothing
    On Error GoTo 0
    Exit Function
    GoTo Exit_for
End Function

Open in new window

james_axtonAuthor Commented:
This was very helpful, however I'm hitting an error I can't get past.

At line 45 in the included Function it halts with an error 91 "Object Variable or With Variable not set".  It highlights this portion of the line:

If RS.State = adStateOpen Then

I was able to troubleshoot my way past other small issues but I can't get this one.  Any ideas?  I've attached the changes to the function that I made.  I also changed the tables variable from String to a Variant to accommodate the array.
Dim CNN As ADODB.Connection  "Added ADODB"
Set CNN = New ADODB.Connection  "Added ADODB"
Dim RS As ADODB.Recordset  "Added ADODB"
Set RS = New ADODB.Recordset  "Added this line"

Open in new window

james_axtonAuthor Commented:
I also failed to mention that I changed the GetTablesADO Function type from String to Variant.  
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Sorry for my late reply, what problem do you still have ?
james_axtonAuthor Commented:
The same problems that were previously mentioned :)  I haven't done anything with them yet.
can you post the code of your getTables and the place you call it !

dim tables as variant
tables = GetTablesADO("YourDatabase")
james_axtonAuthor Commented:
I left everything intact except for the changes mentioned above.
Where do you get an error and what is it telling ?
james_axtonAuthor Commented:
Dhaest, if I did something wrong with respect to replying then I apologize.  Did I not provide enough information in my previous posts?
Can you post the adjusted code .
The code where you call teh getTables-function and the getTables-function !
And also a description of the error you get !
james_axtonAuthor Commented:
I ended up re-writing everything to use OpenSchema(adSchemaTables) to grab my table names and then running a "SELECT Count(*)" against each table - in the same vein as my original code but with correct nomenclature.

To verify that my Excel code was correct I just did a few web searches.  

Thank you for your help.  

Featured Post

Granular recovery for Microsoft Exchange

With Veeam Explorer for Microsoft Exchange you can choose the Exchange Servers and restore points you’re interested in, and Veeam Explorer will present the contents of those mailbox stores for browsing, searching and exporting.

  • 6
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now