'TITLE: Export Metadata to Excel Version 3 'DESCRIPTION: This macro outputs model meta data to Excel in 'a format which may be appealing for a finished report. 'NOTES: ' Information will be exported for each entity/table that is ' selected prior to executing the macro. 'DATE: 3/4/2002 'LAST UPDATE: 10/29/2004 'AUTHOR: Jason Tiret 'CONTACT: http://support.embarcadero.com/ 'Dim ER/Studio variables Dim diag As Diagram Dim mdl As Model Dim submdl As SubModel Dim so As SelectedObject Dim ent As Entity Dim attr As AttributeObj 'dim excel variables Dim wb As Object Dim sheet As Object Dim excel As Object Dim selectedrange As Object Sub Main Set diag = DiagramManager.ActiveDiagram Set mdl = diag.ActiveModel Set submdl = mdl.ActiveSubModel Set excel = CreateObject("excel.application") excel.visible = True Dim curRow As Integer PrintHeader curRow = 4 If submdl.SelectedObjects.Count > 0 Then For Each so In submdl.SelectedObjects If so.Type = 1 Then Set ent = mdl.Entities.Item(so.ID) For Each attr In ent.Attributes sheet.cells(curRow,1).Value = mdl.Name sheet.cells(curRow,2).Value = submdl.Name sheet.cells(curRow,3).Value = ent.EntityName sheet.cells(curRow,4).Value = ent.TableName If attr.HasLogicalRoleName = True Then sheet.cells(curRow,5).Value = attr.LogicalRoleName Else sheet.cells(curRow,5).Value = attr.AttributeName End If sheet.cells(curRow,6).Value = attr.Definition sheet.cells(curRow,7).Value = attr.ColumnName Dim Datastring As String Datastring = attr.CompositeDatatype Datastring = Replace(Datastring, " NOT", "") Datastring = Replace(Datastring, " NULL", "") If InStr(Datastring, "(") <> 0 Then Datastring = Left(Datastring,InStr(Datastring, "(") - 1) End If sheet.cells(curRow,8).Value = Datastring If attr.DataLength > 0 Then sheet.cells(curRow,9).Value = attr.DataLength End If If attr.DataScale > 0 Then sheet.cells(curRow,10).Value = attr.DataScale End If If NullOption(attr) = "N" Then sheet.cells(curRow,12).Value = "OPTIONAL" Else sheet.cells(curRow,12).Value = "MANDATORY" End If sheet.cells(curRow,13).Value = NullOption(attr) sheet.cells(curRow,14).Value = KeyOption(attr) sheet.cells(curRow,15).Value = Identity_value(attr) curRow = curRow + 1 Next End If Next End If End Sub Function Identity_value (att As AttributeObj ) As String Dim Ident_val As String If att.Identity = True Then Ident_val = "YES" Else Ident_val = "NO" End If Identity_value = Ident_val End Function Function KeyOption ( att As AttributeObj ) As String Dim keystr As String If att.PrimaryKey = True Then keystr = "(PK)" End If If att.ForeignKey = True Then keystr = keystr & "(FK)" End If KeyOption = keystr End Function Function NullOption ( att As AttributeObj ) As String Dim nullstr As String If UCase(att.NullOption) = "NULL" Then nullstr = "N" End If If UCase(att.NullOption) = "NOT NULL" Then nullstr = "NN" End If If UCase(att.NullOption) = "NOT NULL" And att.DeclaredDefault <> "" Then nullstr = "ND" End If NullOption = nullstr End Function Function Datatype ( DT As String ) As String Dim test As String test = UCase(DT) Select Case test Case "DATE" Datatype = "D" Case "TIMESTAMP/DATE","TIMESTAMP","DATETIME","DATETIMN","SMALLDATETIME","TIME/DATETIME" Datatype = "T" Case "VARCHAR","VARCHAR2","NVARCHAR","CHAR","LONG VARCHAR","NTEXT/LONG VARCHAR","NCHAR","MLSLABEL/VARCHAR","ROWID/VARCHAR","BIT","BOOL","BOOLEAN","TEXT","IMAGE/LONG BINARY","IMAGE","BINARY","VARBINARY/BLOB","BLOB","CLOB" Datatype = "C" Case "ID","NUMERIC","NUMBER","DECIMAL","MONEY","SMALLMONEY","MONEYN","DECIMALN","PICTURE","FLOAT","SINGLE","REAL/SMALLFLOAT","FLOATN","NUMBER","DOUBLE","DOUBLE PRECISION","INTEGER","INT","INTN","SERIAL/INTEGER","COUNTER","UNIQUEID","SMALLINT","TINYINT" Datatype = "N" Case Else datatyp = "C" End Select End Function Sub PrintHeader Set wb = excel.workbooks.Add Set sheet = wb.activesheet sheet.cells(1,1).Value = diag.ProjectName sheet.cells(1,2).Value = diag.FileName sheet.cells(2,1).Value = "=NOW()" sheet.cells(2,1).font.colorindex = 3 sheet.cells(1,1).font.Size = 12 sheet.cells(1,2).font.Size = 12 sheet.cells(1,1).font.Bold = True sheet.cells(1,2).font.Bold = True With sheet.range("A:P") .WrapText = True .cells.borders.colorindex = 1 .font.Name = "ZapfHumnst BT" End With With sheet.range("A3:P3") .interior.colorindex = 15 .font.Bold = True .font.Size = 9 End With With sheet.range("H:J") .horizontalalignment = -4108 End With sheet.Columns(10).horizontalalignment = -4108 sheet.Columns(1).columnwidth = 22.14 sheet.Columns(2).columnwidth = 22.14 sheet.Columns(3).columnwidth = 22.14 sheet.Columns(4).columnwidth = 16.29 sheet.Columns(5).columnwidth = 17.86 sheet.Columns(6).columnwidth = 52.14 sheet.Columns(7).columnwidth = 22.14 sheet.Columns(8).columnwidth = 14 sheet.Columns(9).columnwidth = 10.29 sheet.Columns(10).columnwidth = 10.71 sheet.Columns(11).columnwidth = 23.43 sheet.Columns(12).columnwidth = 13 sheet.Columns(13).columnwidth = 11.71 sheet.Columns(14).columnwidth = 11.57 sheet.Columns(15).columnwidth = 11.57 sheet.Columns(16).columnwidth = 23.29 sheet.cells(3,1).Value = "MODEL NAME" sheet.cells(3,2).Value = "SUBMODEL NAME" sheet.cells(3,3).Value = "TABLE BUSINESS NAME" sheet.cells(3,4).Value = "TABLE TECHNICAL NAME" sheet.cells(3,5).Value = "COLUMN BUSINESS NAME" sheet.cells(3,6).Value = "COLUMN BUSINESS DEFINITION" sheet.cells(3,7).Value = "COLUMN TECHNICAL NAME" sheet.cells(3,8).Value = "COLUMN DATA TYPE" sheet.cells(3,9).Value = "TOTAL COLUMN LENGTH" sheet.cells(3,10).Value = "# OF PLACES TO RIGHT OF DECIMAL" sheet.cells(3,11).Value = "VALID VALUES" sheet.cells(3,12).Value = "MANDATORY/ OPTIONAL (Is Value Required)" sheet.cells(3,13).Value = "N=NULL NN=Not Null ND=Not Null W/Default" sheet.cells(3,14).Value = "Primary Key (PK) Foreign Key (FK)" sheet.cells(3,15).Value = "COLUMN IS AUTO-INCREMENTED (Identity)" sheet.cells(3,16).Value = "Comments or Source Positions" sheet.cells(4,17).Value = "" With sheet.range("A3:P3") .verticalalignment = -4160 .horizontalalignment = -4108 End With sheet.Columns(15).horizontalalignment = 1 For i = 1 To 11 sheet.cells(1,i).borders(10).colorindex = -4142 sheet.cells(2,i).borders(10).colorindex = -4142 Next End Sub