How to export a table definition into Excel

This works pretty well - I initially found it at the site listed in the comments, and made a few enhancements to get what I wanted. You should be able to just drop this into a module and run it to generate a listing of all your tables and desired properties in Excel.

Happy documenting.

Code:
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



--> This worked so wonderfully! I don't think I have ever implemented code found on a forum to easily. Thank you sooo much! EXACTLY what I needed!!:D
 

Users who are viewing this thread

Back
Top Bottom