'---------------------------------------------------------------------------------------
' Procedure : ListAllTables_Size
' Author : Gustav(original)
' Created : 11/15/2009
' Purpose : To get approximate sizes of all
'non-MSys tables in an Access database
'Outputs table names and sizes to immediate window.
'
'From AccessD discussion-
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs: N/A
' Dependency: Microsoft DAO 3.6 Object Library
'------------------------------------------------------------------------------
'
Public Sub ListAllTables_Size()
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strName As String
Dim strFile As String
Dim strPath As String
Dim lngBase As Long
Dim lngSize As Long
Dim lngTblCnt As Long
10 On Error GoTo ListAllTables_Size_Error
20 Set dbs = CurrentDb
30 strName = dbs.name
40 strPath = Left(strName, Len(strName) - Len(Dir(strName)))
' Create empty database to measure the base file size.
50 strFile = strPath & "base" & ".mdt"
60 CreateDatabase strFile, dbLangGeneral
70 lngBase = FileLen(strFile)
80 Kill strFile
90 Debug.Print "Base size", lngBase / 1024 & " KB" 'report approx KB
100 For Each tdf In dbs.TableDefs
110 strName = tdf.name
' Apply some filtering - ignore System tables.
120 If Left(strName, 4) <> "MSys" Then
130 strFile = strPath & strName & ".mdt"
140 Debug.Print strName & Space(40 - Len(strName)), ;
'create a new database and add 1 table
150 CreateDatabase strFile, dbLangGeneral
160 On Error Resume Next
'transfer 1 table to the new database
170 DoCmd.TransferDatabase acExport, "Microsoft Access", strFile, acTable, strName, strName
'get the size then remove the base size to get approx table size
180 lngSize = FileLen(strFile) - lngBase '
190 lngTblCnt = lngTblCnt + 1
200 Kill strFile 'delete the temporary file
210 Debug.Print lngSize / 1024 & " KB"
220 End If
230 Next
240 Debug.Print vbCrLf & vbTab & "Tables processed:" & lngTblCnt
250 Set tdf = Nothing
260 Set dbs = Nothing
270 On Error GoTo 0
280 Exit Sub
ListAllTables_Size_Exit:
290 Exit Sub
ListAllTables_Size_Error:
300 MsgBox "Error " & err.number & " in line " & Erl & " (" & err.Description & ") in procedure ListAllTables_Size of Module GustavProcs"
310 Resume ListAllTables_Size_Exit
End Sub