' 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