|
|
Title | Use DAO to make an Excel report on an Access database's structure |
Description | This example shows how to use DAO to make an Excel report on an Access database's structure in Visual Basic 6. |
Keywords | Access, database, DAO, Excel, index, relation, table, index |
Categories | Database, 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
|
|
|
|
|
|