Public Sub Tablesay()
'*******************************************
'Purpose: Enumerate tables & descriptions
' in current database
'From: raskew
'Inputs: from immediate (debug) window
' call tablesay
'Output: see immediate window for output
'*******************************************
Dim db As Database
Dim rs As Recordset
Dim strDesc As String
Dim strName As String
Dim strSQL As String
Dim td As TableDef
Dim i As Integer
Dim n As Integer
Dim MyArray() As Variant
Set db = CurrentDb
strSQL = "SELECT MSysObjects.Name, MSysObjects.Type" _
& " FROM MSysObjects" _
& " WHERE (((MSysObjects.Type) In (1,6)) AND ((Left([Name],4))<>'MSys') AND ((Left([Name],1))<>'~'))" _
& " ORDER BY MSysObjects.Name;"
Set rs = db.OpenRecordset(strSQL)
If Not rs.BOF Then
' Get number of records in recordset
rs.MoveLast
n = rs.RecordCount
rs.MoveFirst
End If
'create array of tablenames and descriptions
ReDim MyArray(n - 1, 1) As Variant
On Error Resume Next
For i = 0 To n - 1
Set td = db.TableDefs(rs!Name)
strDesc = " "
strName = td.Name
strDesc = td.Properties("Description")
If Err = 3270 Or strDesc = " " Then '3270 = object not found
strDesc = "No description provided."
Err = 0
End If
strDesc = IIf(rs!Type = 6, "Linked: ", "") & strDesc
MyArray(i, 0) = strName
MyArray(i, 1) = strDesc
rs.MoveNext
Next i
For i = 0 To n - 1
Debug.Print MyArray(i, 0) & " ---" & MyArray(i, 1)
Next i
rs.Close
db.Close
Set db = Nothing
End Sub