Exporting Access 2000 schema

Are there any tools available to help export access 2000
mdb table schemas?

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 String
'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 Long
Dim rstT As DAO.Recordset, rstF As DAO.Recordset, lngTblID As Long

Set rstT = CurrentDb.OpenRecordset("SELECT * FROM tblTable")
Set rstF = CurrentDb.OpenRecordset("SELECT * FROM tblField")

On Error Resume Next
Open sDir & sFile & ".TXT" For Output As #1
SysCmd acSysCmdInitMeter, "Extracting Schema", CurrentDb.TableDefs.Count
Print #1, "Filename: "; sDir & sFile & ".TXT"; " Skip Empty Tables="; SkipEmptyTables; " Skip System Tables="; SkipSystemTables; " Created: "; Now()
Print #1,

For Each tbl In CurrentDb.TableDefs
With tbl
If Not ((.Name Like "MSys*" And SkipSystemTables) Or .Connect Like "*Ugh_Schema.mdb") Then

If toDB Then
With rstT
.AddNew
!Table = tbl.Name
.Update
If Err.Number 0 Then 'duplicate
rstT.FindFirst "Table='" & tbl.Name & "'"
If .NoMatch Then
Debug.Print "ERROR FINDING TABLE: " & tbl.Name
Else
.Edit
!Del = Null
.Update
End If
Err.Clear
Else
.Bookmark = .LastModified
End If
lngTblID = !TblID
End With
End If

lrc = DCount(.Fields(0).Name, .Name)

If Err 0 Then
Print #1, "Table: " & .Name & " Error: could not open."
Print #1,
Err.Clear
Else
If Not (SkipEmptyTables And lrc = 0) Then
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 .Fields

If toDB Then
With rstF
.AddNew
!TblID = lngTblID
!Field = fld.Name
!Type = fld.Type
!Size = fld.Size
Err.Clear
.Update
If Err.Number 0 Then 'duplicate
rstF.FindFirst "Field='" & fld.Name & "' AND TblID=" & lngTblID
If .NoMatch Then
Debug.Print "ERROR FINDING FIELD: " & fld.Name & ", TABLE: " & tbl.Name
Err.Clear
Else
.Edit
!Del = Null
If Nz(!Size, 0) fld.Size Then
!dtmLU = Now()
!Size = fld.Size
End If
If Nz(!Type) fld.Type Then
!dtmLU = Now()
!Type = fld.Type
End If
.Update
End If
End If
End With
End If

With fld
If Not SkipFieldUsage Then If .Type = 10 Or .Type = 12 Then lsize = Nz(DMax("Len(TRIM([" & .Name & "]))", tbl.Name), 0) Else lsize = -1
Print #1, " "; .Name; Tab(40); FldTypeName(.Type), .Size, IIf(lsize -1 And lrc 0 And Not SkipFieldUsage, lsize, "")
End With
Next fld
Print #1, "End Table"
Print #1,
End If
End If
End If
End With
ltbls = ltbls + 1
SysCmd acSysCmdUpdateMeter, ltbls

Next tbl

Close #1

SysCmd acSysCmdRemoveMeter

'update deleted fields
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