Sub Lista_Tamanho_Todas_Tabelas()
' Author: André Bernardes
' Date: 28/07/14 - 10:13
' Application: *** SalesForce®
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
On Error GoTo ListAllTables_Size_Error
Set dbs = CurrentDb
Let strName = dbs.Name
Let strPath = Left(strName, Len(strName) - Len(Dir(strName)))
' Cria um database vazio para medir o tamanho do arquivo.
Let strFile = strPath & "base" & ".mdt"
CreateDatabase strFile, dbLangGeneral
Let lngBase = FileLen(strFile)
Kill strFile
Debug.Print "Tamanho Base: ", lngBase
For Each tdf In dbs.TableDefs
Let strName = tdf.Name
' Appica um filtro para ignorar as tabelas internas de sistema do MS Access.
If Left(strName, 4) <> "MSys" Then
Let strFile = strPath & strName & ".mdt"
Debug.Print strName, ;
CreateDatabase strFile, dbLangGeneral
DoCmd.TransferDatabase acExport, "Microsoft Access", strFile, acTable, strName, strName
Let lngSize = FileLen(strFile) - lngBase
Kill strFile
Debug.Print lngSize
End If
Next
Set tdf = Nothing
Set dbs = Nothing
On Error GoTo 0
Exit Sub
ListAllTables_Size_Error:
MsgBox "Erro: " & Err.Number & " (" & Err.Description & ") na SUB Lista_Tamanho_Todas_Tabelas."
End Sub