Solved: List contents of table fields in design view.

[Marcster]

When you open a table in design view, you can see the Field Name, Data Type and Description fields. The information shown on screen here is what I want to be listed in a new table.

Is there a way via VBA to list the contents of Field Name, Data Type and Description of all the tables in the current database?.
If so, what I would like to be able to do is have a VBA procedure which lists
this information in a new table in the current database.

New table to contain:

TableName
FieldName
DataType
Description

Can this be done using Access 2000?.

If so, it would be a great routine to have for database documentational purposes.

If not, i'll just do it manually.

Thanks in advance,

Marcster.

I'm currently looking through the help file
'Microsoft DAO 3.6'
filename: 'DAO360.CHM' for ideas.

[Norie]

The following code works for the field names.

To a meaningful field type would need further coding as they are stored as constants like dbText etc

By the way what do you mean by description?

Sub Test()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim tdfNew As DAO.TableDef
Dim fld As DAO.Field
Dim rst As DAO.Recordset
Set db = CurrentDb

Set tdfNew = db.CreateTableDef("ListFields")

Set fld = tdfNew.CreateField("TableName", dbText)

tdfNew.Fields.Append fld

Set fld = tdfNew.CreateField("FieldName", dbText)

tdfNew.Fields.Append fld
db.TableDefs.Append tdfNew

Set rst = db.OpenRecordset(tdfNew.Name)

For Each tdf In db.TableDefs
If tdf.Name <> tdfNew.Name Then
For Each fld In tdf.Fields
With rst
.AddNew
.Fields("TableName") = tdf.Name
.Fields("FieldName") = fld.Name
.Update
End With
Next
End If
Next

rst.Close
Set db = Nothing

End Sub

[Marcster]

Thanks Norie,

That points me in the right direction.
By Description I mean:
When you open a table in design view you can see the coloumns:
Field Name
Data Type
Description

[geekgirlau]

Sub DocumentFields()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim tdfNew As DAO.TableDef
Dim fld As DAO.Field
Dim prp As Property
Dim rst As DAO.Recordset


On Error GoTo ErrHandler
Set db = CurrentDb

' table may already exist
On Error Resume Next
Set tdfNew = db.TableDefs("ListFields")

' create table if missing
If Err.Number <> 0 Then
Set tdfNew = db.CreateTableDef("ListFields")
Set fld = tdfNew.CreateField("TableName", dbText)
tdfNew.Fields.Append fld

Set fld = tdfNew.CreateField("FieldName", dbText)
tdfNew.Fields.Append fld

Set fld = tdfNew.CreateField("FieldDesc", dbText)
tdfNew.Fields.Append fld

Set fld = tdfNew.CreateField("FieldType", dbText)
tdfNew.Fields.Append fld

db.TableDefs.Append tdfNew

Else
' clear existing records
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM ListFields"
DoCmd.SetWarnings True
End If

On Error GoTo ErrHandler
Set rst = db.OpenRecordset(tdfNew.Name)

' loop through tables (excluding system tables)
For Each tdf In db.TableDefs
If tdf.Name <> tdfNew.Name And LCase(Left(tdf.Name, 4)) <> "msys" Then
For Each fld In tdf.Fields
With rst
.AddNew
.Fields("TableName") = tdf.Name
.Fields("FieldName") = fld.Name
.Fields("FieldDesc") = fld.Properties("Description")
.Fields("FieldType") = GetType(fld.Type)
.Update
End With
Next
End If
Next


ExitHere:
On Error Resume Next
rst.Close
db.Close

Set fld = Nothing
Set tdf = Nothing
Set tdfNew = Nothing
Set prp = Nothing
Set rst = Nothing
Set db = Nothing
Exit Sub

ErrHandler:
' property not found - need to create
If Err.Number = 3270 Then
Set prp = fld.CreateProperty("Description", dbText)
prp.Value = "No Description Set"
fld.Properties.Append prp

Err.Clear
Resume

Else
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere
End If
End Sub
Function GetType(intType As Integer) As String
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Purpose: Return a text description of the field type
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Select Case intType
Case 1: GetType = "Yes/No"
Case 2: GetType = "Byte"
Case 3: GetType = "Integer"
Case 4: GetType = "Long Integer"
Case 5: GetType = "Currency"
Case 6: GetType = "Single"
Case 7: GetType = "Double"
Case 8: GetType = "Date"
Case 10: GetType = "Text"
Case 11: GetType = "OLE Object"
Case 12: GetType = "Memo"
End Select
End Function

[Marcster]

Very impressive geekgirlau :yay.

Works a treat, thanks very much :clap2::bow: .

Marcster.

[geekgirlau]

My pleasure!