Couple of Macro requests? Automated View Generation/Metadata update / Data Model Metrics

Hello,

we are looking for a macro that can do the following:

1. Take each table in turn

2. Create a view based on the physical data model's table exact structure, with a specific pre-fix

Another one:

1. Can we have the Export Meta Data to Excel Version 3.1 extended to include the name of the Domain to which an attribute is bound?

Final One

Data Model Metrics:

Can we have a macro that produces the following metrics for all models in a DM1 file, split by model:

1) # of Entities

1b) # of Entities without definitions

2) # of attributes

2b) # of attributes without definitions

3) # of relationships

4) # of Primary, Alternate & Foreign Keys

Kind regards

Cheryl

Parents
  • Here's a modified "Export Meta Data to Excel..." macro which includes domains.  

    3223.Export Meta Data to Excel Version 3.1 including Domains.txt
    'TITLE:  Export Meta Data 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
    
    
    '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 dict As Dictionary
    
    '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 dict = diag.Dictionary
    
    	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
    
    				If attr.DomainId > 0 Then
    					sheet.cells(curRow, 8).Value = dict.Domains.Item(attr.DomainId).Name
    				End If
    
    				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,9).Value = Datastring
    
    				If attr.DataLength > 0 Then
    					sheet.cells(curRow,10).Value = attr.DataLength
    				End If
    
    				If attr.DataScale > 0 Then
    					sheet.cells(curRow,11).Value = attr.DataScale
    				End If
    
    				If NullOption(attr) = "N" Then
    					sheet.cells(curRow,13).Value = "OPTIONAL"
    				Else
    					sheet.cells(curRow,13).Value = "MANDATORY"
    				End If
    
    				sheet.cells(curRow,14).Value = NullOption(attr)
    				sheet.cells(curRow,15).Value = KeyOption(attr)
    				sheet.cells(curRow,16).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:R")
    			.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.29
    	sheet.Columns(11).columnwidth = 10.71
    	sheet.Columns(12).columnwidth = 23.43
    	sheet.Columns(13).columnwidth = 13
    	sheet.Columns(14).columnwidth = 11.71
    	sheet.Columns(15).columnwidth = 11.57
    	sheet.Columns(16).columnwidth = 11.57
    	sheet.Columns(17).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 = "DOMAIN NAME"
    	sheet.cells(3,9).Value = "COLUMN DATA TYPE"
    	sheet.cells(3,10).Value = "TOTAL COLUMN LENGTH"
    	sheet.cells(3,11).Value = "# OF PLACES TO RIGHT OF DECIMAL"
    	sheet.cells(3,12).Value = "VALID VALUES"
    	sheet.cells(3,13).Value = "MANDATORY/ OPTIONAL         (Is Value Required)"
    	sheet.cells(3,14).Value = "N=NULL NN=Not Null ND=Not Null W/Default"
    	sheet.cells(3,15).Value = "Primary Key (PK)           Foreign Key (FK)"
    	sheet.cells(3,16).Value = "COLUMN IS AUTO-INCREMENTED (Identity)"
    	sheet.cells(3,17).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
    

Reply Children
No Data