' Uncomment (Remove the ' ) the two lines of code below if they are not already at the top of your Module
'Option Compare Database
'Option Explicit
 
 
'---------------------------------------------------------------------------------------
' Procedure : ListAllTblDefs
' DateTime  : 7/19/2008
' Author    : Patrick Wood  http://gainingaccess.net
' Purpose   : Count and List All Tables in a database
' Usage     : You are welcome to use and modify this code
'           : if you leave this header intact.
'---------------------------------------------------------------------------------------
'
Function ListAllTblDefs()
On Error GoTo Err_ListAllTblDefs
   Dim db As DAO.Database
   Dim tdf As DAO.TableDef
   Dim intcount As Long
   intcount = 0
 
   Set db = CurrentDb()
 
    For Each tdf In db.TableDefs
        intcount = intcount + 1
       Debug.Print intcount & " " & tdf.Name
    Next
 
    Set db = Nothing
 
Exit_ListAllTblDefs:
   Exit Function
 
Err_ListAllTblDefs:
   MsgBox Err.Number & " " & Err.Description
   GoTo Exit_ListAllTblDefs
 
End Function
 
 
'---------------------------------------------------------------------------------------
' Procedure : RecordCountTables
' DateTime  : 1/29/2008
' Author    : Patrick Wood  http://gainingaccess.net
' Purpose   : Count and list all table names and each table's recordcount
' Usage     : You are welcome to use and modify this code
'           : if you leave this header intact.
'---------------------------------------------------------------------------------------
'
Sub RecordCountTables()
 
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef
    Dim rct As Long
    Dim intcount As Integer
 
    intcount = 0
    Set dbs = CurrentDb()
 
    Debug.Print Now()
    Debug.Print dbs.Name
    Debug.Print "Count | TableName | RecordCount"
    Debug.Print "-------------------------------"
 
    For Each tdf In dbs.TableDefs
        rct = tdf.RecordCount
        intcount = intcount + 1
        Debug.Print intcount & " " & tdf.Name & " " & rct
    Next tdf
 
    Set tdf = Nothing
    Set dbs = Nothing
 
End Sub
 
'---------------------------------------------------------------------------------------
' Procedure : RecordCountRemoteTables
' DateTime  : 1/29/2008
' Author    : Patrick Wood  http://gainingaccess.net
' Purpose   : Count and list all table names and each table's recordcount in remote DB
' Arguments : DBPath--A string that is the full path and name of a remote Database
' Example   : RecordCountRemoteTables("C:\MyDatabases\MyDatabase.mdb")
' Usage     : You are welcome to use and modify this code
'           : if you leave this header intact.
'---------------------------------------------------------------------------------------
'
Sub RecordCountRemoteTables(DbPath As String)
 
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef
    Dim rct As Long
    Dim intcount As Integer
        intcount = 0
 
    Set dbs = OpenDatabase(DbPath)
 
    Debug.Print Now()
    Debug.Print dbs.Name
    Debug.Print "Count | TableName | RecordCount"
    Debug.Print "-------------------------------"
 
    For Each tdf In dbs.TableDefs
        rct = tdf.RecordCount
        intcount = intcount + 1
        Debug.Print intcount & " " & tdf.Name & " " & rct
    Next tdf
 
    Set tdf = Nothing
    Set dbs = Nothing
 
End Sub
 
 
'---------------------------------------------------------------------------------------
' Procedure : TablesFieldsStats
' Author    : Microsoft--Modified by Patrick Wood http://gainingaccess.net
' Purpose   : Writes Information about tables to a text file
' Arguments : strtxtFileName - The File Name and Path of the new Text File
' Example   : Call TablesFieldsStats("D:\MyDatabase\DBInfo.txt")
'---------------------------------------------------------------------------------------
Function TablesFieldsStats(strtxtFileName As String)
 
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As Field
    Dim fs, f
    Dim prpLoop As Property
    Const ForReading = 1, ForWriting = 2
 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.CreateTextFile(strtxtFileName, ForWriting, True)
 
    f.WriteLine "All Tables Information"
    'Fill table with table and field names
    Set db = CurrentDb
 
    For Each tdf In db.TableDefs
        If Left(tdf.Name, 4) = "Msys" Then
            'Skip the System tables
        Else
            f.WriteLine " "
            f.WriteLine "=============== Table Name: " & tdf.Name & " ==============="
            f.WriteLine " "
            For Each fld In tdf.Fields
                f.WriteLine "---------- Field: " & fld.Name & " ----------"
                ' Enumerate Properties collection of passed Field
                ' object.
                For Each prpLoop In fld.Properties
                ' Some properties are invalid in certain
                ' contexts (the Value property in the Fields
                ' collection of a TableDef for example). Any
                ' attempt to use an invalid property will
                ' trigger an error.
                     On Error Resume Next
    '                 Debug.Print "  " & prpLoop.Name & " = " & _
    '                    prpLoop.Value
                    f.WriteLine "  " & prpLoop.Name & " = " & prpLoop.Value
                Next prpLoop
            Next fld
        End If
    Next tdf
 
    f.Close
 
    Debug.Print strtxtFileName & " created"
 
    Set f = Nothing
    Set tdf = Nothing
    Set db = Nothing
 
End Function