Sub ListTablesAndFields()
'Macro Purpose: Write all table and field names to and Excel file
'Source: vbaexpress.com/kb/getarticle.php?kb_id=707
'Updates by Derek - Added column headers, modified base setting for loop to include all fields,
' added type, size, and description properties to export
Dim lTbl As Long
Dim lFld As Long
Dim dBase As Database
Dim xlApp As Object
Dim wbExcel As Object
Dim lRow As Long
'Set current database to a variable adn create a new Excel instance
Set dBase = CurrentDb
Set xlApp = CreateObject("Excel.Application")
Set wbExcel = xlApp.workbooks.Add
'Set on error in case there are no tables
On Error Resume Next
'DJK 2011/01/27 - Added in column headers below
lRow = 1
With wbExcel.sheets(1)
.Range("A" & lRow) = "Table Name"
.Range("B" & lRow) = "Field Name"
.Range("C" & lRow) = "Type"
.Range("D" & lRow) = "Size"
.Range("E" & lRow) = "Description"
End With
'Loop through all tables
For lTbl = 0 To dBase.TableDefs.Count
'If the table name is a temporary or system table then ignore it
If Left(dBase.TableDefs(lTbl).Name, 1) = "~" Or _
Left(dBase.TableDefs(lTbl).Name, 4) = "MSYS" Then
'~ indicates a temporary table
'MSYS indicates a system level table
Else
'Otherwise, loop through each table, writing the table and field names
'to the Excel file
For lFld = 0 To dBase.TableDefs(lTbl).Fields.Count - 1 'DJK 2011/01/27 - Changed initial base from 1 to 0, and added type, size, and description
lRow = lRow + 1
With wbExcel.sheets(1)
.Range("A" & lRow) = dBase.TableDefs(lTbl).Name
.Range("B" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Name
.Range("C" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Type
.Range("D" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Size
.Range("E" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Properties("Description")
End With
Next lFld
End If
Next lTbl
'Resume error breaks
On Error GoTo 0
'Set Excel to visible and release it from memory
xlApp.Visible = True
Set xlApp = Nothing
Set wbExcel = Nothing
'Release database object from memory
Set dBase = Nothing
End Sub
