Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleUse DAO to make an Excel report on an Access database's structure
DescriptionThis example shows how to use DAO to make an Excel report on an Access database's structure in Visual Basic 6.
KeywordsAccess, database, DAO, Excel, index, relation, table, index
CategoriesDatabase, Utilities
 
This program uses Excel and DAO so you need to add references to the Excel and DAO object libraries. Select the Project menu's References command, select the Microsoft Excel 9.0 Object Library and the DAO 3.6 Object Library (or whatever versions you have), and click OK.

When you click the Analyze button, the program creates an Excel application object. It makes a new Workbook and gets a reference to its first Worksheet.

The program writes some headers into the Worksheet. It then opens the database and loops through its TableDefs collection representing the database's tables. For each TableDef (skipping the system tables, which have names starting with MSys), the program adds the table's name to the Excel Worksheet. It also displays the table's Description property. If the table has no Description, this value is missing from the Properties collection so the program uses an On Error statement so it doesn't crash when it tries to access the missing value.

Next the program loops through the objects in the TableDef's Fields collection. Each of these Field objects represents a field in the table. The program loops through a list of Field properties (Name, Type, Size, AllowZeroLength, DefaultValue, Required, Description) and displays their values. It uses the TypeName function to convert a numeric database type name into a type string such as Integer or Boolean.

After displaying the table's fields, the program loops through the TableDef's Indexes collection. For each Index in the collection, the program displays the index's Name, Primary, Required, Unique, and Foreign property values. It then loops through the index's fields, displaying the names of each field in the index.

After it has finished displaying information about all of the database's tables and their indexes, the program describes the database's relations by looping through the Relations collection. The program displays each Relation's name. It then loops through the fields that define the relation, displaying the source and foreign table and field names.

 
Private Sub cmdAnalyze_Click()
Dim excel_app As Excel.Application
Dim excel_workbook As Excel.Workbook
Dim excel_worksheet As Excel.Worksheet
Dim max_table_row As Integer
Dim row_num As Integer
Dim col_num As Integer
Dim db As DAO.Database
Dim field_properties() As String
Dim index_properties() As String
Dim table_def As DAO.TableDef
Dim field_def As DAO.Field
Dim index_def As DAO.Index
Dim relation_def As DAO.Relation
Dim txt As String
Dim i As Integer

    Screen.MousePointer = vbHourglass
    DoEvents

    field_properties = _
        Split("Name,Type,Size,AllowZeroLength,DefaultValue,Required,Description", _
        ",")
    index_properties = _
        Split("Name,Primary,Required,Unique,Foreign", ",")

    ' Open Excel and create a new workbook.
    Set excel_app = New Excel.Application
    Set excel_workbook = excel_app.Workbooks.Add()
    Set excel_worksheet = excel_workbook.Sheets(1)

    ' Examine the tables.
    row_num = 1

    ' Section heading.
    excel_worksheet.Cells(row_num, 1) = "Tables"
    With excel_worksheet.Range("A" & row_num).Font
        .Size = 25
        .Bold = True
        .Color = vbRed
    End With
    row_num = row_num + 1

    Set db = DBEngine(0).OpenDatabase(txtDatabase.Text, _
        ReadOnly:=False)
    For Each table_def In db.TableDefs
        Me.Caption = "MDBAnalyzer: " & table_def.Name
        DoEvents

        ' Skip the system tables.
        If LCase$(Left$(table_def.Name, 4)) <> "msys" Then
            ' Display this table.
            excel_worksheet.Cells(row_num, 1) = _
                table_def.Name
            With excel_worksheet.Range("A" & row_num).Font
                .Size = 20
                .Bold = True
                .Color = vbBlue
            End With

            row_num = row_num + 1
            On Error Resume Next
            txt = table_def.Properties("Description")
            If Err.Number <> 0 Then txt = "?????"
            excel_worksheet.Cells(row_num, 1) = txt
            On Error GoTo 0
            row_num = row_num + 1

            ' Display field data.
            excel_worksheet.Cells(row_num, 1) = "Fields"
            With excel_worksheet.Range("A" & row_num).Font
                .Size = 16
                .Bold = True
            End With
            row_num = row_num + 1

            ' Headers.
            For col_num = LBound(field_properties) To _
                UBound(field_properties)
                excel_worksheet.Cells(row_num, col_num + 1) _
                    = field_properties(col_num)
            Next col_num
            With excel_worksheet.Range("A" & row_num, "Z" & _
                row_num).Font
                .Bold = True
            End With
            row_num = row_num + 1

            ' Fields.
            For Each field_def In table_def.Fields
                For col_num = LBound(field_properties) To _
                    UBound(field_properties)
                    If field_properties(col_num) = "Type" _
                        Then
                        excel_worksheet.Cells(row_num, _
                            col_num + 1) = _
                            TypeName(field_def.Type)
                    Else
                        On Error Resume Next
                        txt = field_def.Properties(field_properties(col_num))
                        If Err.Number <> 0 Then txt = _
                            "?????"
                        excel_worksheet.Cells(row_num, _
                            col_num + 1) = txt
                        On Error GoTo 0
                    End If
                Next col_num
                row_num = row_num + 1
            Next field_def

            ' Display index information.
            excel_worksheet.Cells(row_num, 1) = "Indexes"
            With excel_worksheet.Range("A" & row_num).Font
                .Size = 16
                .Bold = True
            End With
            row_num = row_num + 1

            ' Headers.
            For col_num = LBound(index_properties) To _
                UBound(index_properties)
                excel_worksheet.Cells(row_num, col_num + 1) _
                    = index_properties(col_num)
            Next col_num
            excel_worksheet.Cells(row_num, _
                UBound(index_properties) + 2) = "Fields"
            With excel_worksheet.Range("A" & row_num, "Z" & _
                row_num).Font
                .Bold = True
            End With
            row_num = row_num + 1

            ' Indexes.
            For Each index_def In table_def.Indexes
                For col_num = LBound(index_properties) To _
                    UBound(index_properties)
                    On Error Resume Next
                    txt = index_def.Properties(index_properties(col_num))
                    If Err.Number <> 0 Then txt = "?????"
                    excel_worksheet.Cells(row_num, col_num _
                        + 1) = txt
                    On Error GoTo 0
                Next col_num

                ' List the index's fields.
                col_num = UBound(index_properties) + 2
                If index_def.Fields.Count > 0 Then
                    For Each field_def In index_def.Fields
                        excel_worksheet.Cells(row_num, _
                            col_num) = field_def.Name
                        row_num = row_num + 1
                    Next field_def
                Else
                    row_num = row_num + 1
                End If
            Next index_def

            row_num = row_num + 1
        End If ' End if not MSys table.
    Next table_def

    ' Display database relations.
    ' Section heading.
    excel_worksheet.Cells(row_num, 1) = "Relations"
    With excel_worksheet.Range("A" & row_num).Font
        .Size = 25
        .Bold = True
        .Color = vbRed
    End With
    row_num = row_num + 1

    ' Headers.
    excel_worksheet.Cells(row_num, 1) = "Name"
    excel_worksheet.Cells(row_num, 2) = "Source Table"
    excel_worksheet.Cells(row_num, 3) = "Foreign Table"
    excel_worksheet.Range("A" & row_num, "C" & _
        row_num).Font.Bold = True
    row_num = row_num + 1

    ' Display the relations.
    For Each relation_def In db.Relations
        excel_worksheet.Cells(row_num, 1) = _
            relation_def.Name
        For i = 0 To relation_def.Fields.Count - 1
            Set field_def = relation_def.Fields(i)
            excel_worksheet.Cells(row_num, 2) = _
                relation_def.Table & "." & _
                field_def.Name
            excel_worksheet.Cells(row_num, 3) = _
                relation_def.ForeignTable & "." & _
                field_def.ForeignName
            row_num = row_num + 1
        Next i
    Next relation_def

    excel_worksheet.Range("A1", "Z" & _
        row_num).Columns.ColumnWidth = 20

    ' Display the Excel application.
    ' Comment this out, save the file, and close the
    ' application
    ' if you want to do it all silently.
    excel_app.Visible = True

    Me.Caption = "Done"
    Screen.MousePointer = vbDefault
    MsgBox "Done"
End Sub
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated