Sub WriteFieldNames()
Dim oFile As String
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim sType As String
Dim tsize1 As Long
Dim tsize2 As Long
Dim tsize3 As Long
Dim tsize4 As Long
Dim tsize5 As Long
Dim Rs As Recordset
Dim strSelect As String
tsize5 = 0
Set dbs = CurrentDb()
oFile = CurrentProject.Path & "\Fields.txt"
MsgBox "Table sizes will be saved in: " & oFile
On Error Resume Next
Kill (oFile)
On Error GoTo 0
Open oFile For Output As #1
For Each tdf In dbs.TableDefs
'If table is linked, go to next table
If Len(Nz(tdf.Connect)) = 0 Then
'MsgBox (tdf.Name) 'for debugging only
strSelect = "Select * From " & tdf.Name
Set Rs = CurrentDb.OpenRecordset(strSelect)
If Rs.RecordCount = 0 Then
tsize3 = 0
Else
Rs.MoveLast
tsize3 = Rs.RecordCount
End If
If Left(tdf.Name, 4) <> "Msys" And Left(tdf.Name, 1) <> "~" Then
Print #1, Chr(10)
Print #1, tdf.Name
tsize1 = 0
For Each fld In tdf.Fields
tsize2 = 0
Select Case fld.Type
Case 2 'integer
sType = "Integer"
tsize2 = CInt(fld.Size)
Case 3 'Double
sType = "Double"
tsize2 = CInt(fld.Size)
Case 4 'long
sType = "Long"
tsize2 = CInt(fld.Size)
Case 5 'currency
sType = "Currency"
tsize2 = CInt(fld.Size)
Case 6 'memo
sType = "Memo"
tsize2 = CInt(fld.Size)
Case 8 'date/time
sType = "Date/Time"
tsize2 = CInt(fld.Size)
Case 10 'text
sType = "Text"
tsize2 = CInt(fld.Size)
End Select
tsize1 = tsize1 + tsize2
Print #1, fld.Name & "; " & sType & " (" & CLng(tsize2) & ")"
tsize1 = tsize1 + tsize2 + fld.Size
Next fld
tsize4 = tsize1 * tsize3 / 1024
Print #1, "Record size = " & CLng(tsize1) & " Number of Records = " _
; CLng(tSze3) & " Tablesize = " & CLng(tsize4) & " kB"
tsize5 = tsize5 + tsize4
End If
End If
Next tdf
Print #1, Chr(10) & "Total of all table sizes excluding linked tables = " & CLng(tsize5) & " kB"
Close 1
MsgBox "Complete"
End Sub