You didn't say what format to. XML export and look at XSD file might work - cant remember if its in 2k
IF you want a text file then I use this. Not clean or effiicient but it works. Also determines field usage, record count - good for all those '255' fields. Set toDB= false, that's used to monitor revisions to someone elses monster - you'd need the specified tables, not provided - create dummies or comment it out. Hope it helps
Public Function Schema(Optional sFile As String = "SCHEMA", Optional sDir As String = "C:\TEMP\", Optional SkipEmptyTables As Boolean = True, Optional SkipSystemTables As Boolean = True, Optional SkipFieldUsage As Boolean = False, Optional toDB As Boolean = True) As Strin
'Outputs to file the structure of all non-tables in database, and the maximum length used of the each field
Dim fld As DAO.Field, tbl As TableDef, lsize As Long, lexcess As Long, ltbls As Long, lrc As Lon
Dim rstT As DAO.Recordset, rstF As DAO.Recordset, lngTblID As Lon
Set rstT = CurrentDb.OpenRecordset("SELECT * FROM tblTable"
Set rstF = CurrentDb.OpenRecordset("SELECT * FROM tblField"
On Error Resume Nex
Open sDir & sFile & ".TXT" For Output As #
SysCmd acSysCmdInitMeter, "Extracting Schema", CurrentDb.TableDefs.Coun
Print #1, "Filename: "; sDir & sFile & ".TXT"; " Skip Empty Tables="; SkipEmptyTables; " Skip System Tables="; SkipSystemTables; " Created: "; Now(
Print #1
For Each tbl In CurrentDb.TableDef
With tb
If Not ((.Name Like "MSys*" And SkipSystemTables) Or .Connect Like "*Ugh_Schema.mdb") The
If toDB The
With rst
.AddNe
!Table = tbl.Nam
.Updat
If Err.Number > 0 Then 'duplicat
rstT.FindFirst "Table='" & tbl.Name & "'
If .NoMatch The
Debug.Print "ERROR FINDING TABLE: " & tbl.Nam
Els
.Edi
!Del = Nul
.Updat
End I
Err.Clea
Els
.Bookmark = .LastModifie
End I
lngTblID = !TblI
End Wit
End I
lrc = DCount(.Fields(0).Name, .Name
If Err > 0 The
Print #1, "Table: " & .Name & " Error: could not open.
Print #1
Err.Clea
Els
If Not (SkipEmptyTables And lrc = 0) The
Print #1, "Table: " & .Name; Tab(40); "Records: " & lrc; Tab(60); IIf(.Connect <> "", "Connect: " & .Connect, ""
Print #1, " "; "Name"; Tab(40); "Type", "Size", IIf(lrc > 0 And Not SkipFieldUsage, "Used", " "
For Each fld In .Field
If toDB The
With rst
.AddNe
!TblID = lngTblI
!Field = fld.Nam
!Type = fld.Typ
!Size = fld.Siz
Err.Clea
.Updat
If Err.Number > 0 Then 'duplicat
rstF.FindFirst "Field='" & fld.Name & "' AND TblID=" & lngTblI
If .NoMatch The
Debug.Print "ERROR FINDING FIELD: " & fld.Name & ", TABLE: " & tbl.Nam
Err.Clea
Els
.Edi
!Del = Nul
If Nz(!Size, 0) <> fld.Size The
!dtmLU = Now(
!Size = fld.Siz
End I
If Nz(!Type) <> fld.Type The
!dtmLU = Now(
!Type = fld.Typ
End I
.Updat
End I
End I
End Wit
End I
With fl
If Not SkipFieldUsage Then If .Type = 10 Or .Type = 12 Then lsize = Nz(DMax("Len(TRIM([" & .Name & "]))", tbl.Name), 0) Else lsize = -
Print #1, " "; .Name; Tab(40); FldTypeName(.Type), .Size, IIf(lsize > -1 And lrc > 0 And Not SkipFieldUsage, lsize, ""
End Wit
Next fl
Print #1, "End Table
Print #1
End I
End I
End I
End Wit
ltbls = ltbls +
SysCmd acSysCmdUpdateMeter, ltbl
Next tb
Close #
SysCmd acSysCmdRemoveMete
'update deleted field
CurrentDb.Execute "UPDATE tblField SET dtmLU = Now(), Del = 1 WHERE (Del = 0);
CurrentDb.Execute "UPDATE tblField SET Del = 0 WHERE (Del Is Null);"
'update deleted tables
CurrentDb.Execute "UPDATE tblTable SET dtmLU = Now(), Del = 1 WHERE (Del = 0);"
CurrentDb.Execute "UPDATE tblTable SET Del = 0 WHERE (Del Is Null);"
End Function
Public Function FldTypeName(lType As Long) As String
'For use with FldSize
FldTypeName = Choose(lType, "Yes/No", "Byte", "Integer", "Long", "Currency", "Single", "Double", "Date/Time", "9", "Text", "OLE", "Memo")
End Function
Public Function SQLFldTypeStr(fld As DAO.Field) As String
SQLFldTypeStr = Choose(fld.Type, "BOOLEAN", "BYTE", "SHORT", "LONG", "CURRENCY", "SINGLE", "DOUBLE", "DATETIME", "9", "TEXT", "LONGBINARY", "LONGTEXT")
End Function
