Home > Resource Center > Also add Data Security Information

Also add Data Security Information

Introduction

This is the third post regarding the binding of custom properties to specific ER objects.

With the first one, we saw how to bind attachments to one type of ER object.

In the second post, we extended the different macros to bind the attachments to several ER objects.

Now, in this one, we’ll support some new ER objects (Models, Submodels, Business Data Objects) and we’ll filter the types of ER objects that can be bound to each Attachment Type.

Attachment Type Usage
Attachment Type Usage

Even more importantly, we’ll also integrate the Data Security Information so it can also be automatically bound to their relative ER Objects.

Data Security Information
Data Security Information

By the way, the different strings used by the macros for the Attachment Types, Security Types, Excel Spreadsheets can be easily customized in the script named wBindPropertiesToERObjects.bas.

' Labels used in the different Attachments or Security Data Information Types
Public Const MODELS$			= "Models"
Public Const SUBMODELS$			= "Submodels"
Public Const BUSINESSDATAOBJECTS$	= "BusinessDataObjects"
Public Const ENTITIES$			= "Entities"
Public Const TABLES$			= "Tables"
Public Const VIEWS$			= "Views"
Public Const RELATIONSHIPS$ 		= "Relationships"
Public Const ATTRIBUTES$		= "Attributes"
Public Const COLUMNS$			= "Columns"

' Delimiter used between the different Labels
Public Const DELIMITER$			= "|"

' Empty = Local Data Dictionary; Name of the Enterprise Data Dictionary
Public Const DICTIONARY_NAME$		= "Custom properties"
'Public Const DICTIONARY_NAME$		= ""

' Excel sheets names
Public Const XL_TAB_ATTACHMENT$ 	= "Attachments"
Public Const XL_TAB_SECURITY$		= "Data Security Information"

Feel free to update them according to your requirements.

This short video shows the usage of an Enterprise Data Dictionary containing Attachments and Data Security Information with different projects:

Below are the 5 usual scripts updated with the previously mentioned enhancements.

Scripts

wBindPropertiesToERObjects.bas

'#Language "WWB-COM"
''MACRO TITLE: wBind Properties to ER Objects
' MACRO VERSION: 3.0
'This macro binds the Attachments and Data Security Information
'	for Entities, Tables, Attributes, Columns, Relationships, Views,
'	Models, Submodels & Business Data Objects
'
' Release notes
' 3.0: Bind Data Security Information too
' 2.0: ToImportExport & IsMatching functions added
' 1.0: Initial version
'---------------------------------------------------------------------------

Option Explicit

' Labels used in the different Attachments or Security Data Information Types
Public Const MODELS$			= "Models"
Public Const SUBMODELS$			= "Submodels"
Public Const BUSINESSDATAOBJECTS$	= "BusinessDataObjects"
Public Const ENTITIES$			= "Entities"
Public Const TABLES$			= "Tables"
Public Const VIEWS$			= "Views"
Public Const RELATIONSHIPS$ 		= "Relationships"
Public Const ATTRIBUTES$		= "Attributes"
Public Const COLUMNS$			= "Columns"

' Delimiter used between the different Labels
Public Const DELIMITER$			= "|"

' Empty = Local Data Dictionary; Name of the Enterprise Data Dictionary
Public Const DICTIONARY_NAME$		= "Custom properties"
'Public Const DICTIONARY_NAME$		= ""

' Excel sheets names
Public Const XL_TAB_ATTACHMENT$ 	= "Attachments"
Public Const XL_TAB_SECURITY$		= "Data Security Information"

' DO NOT EDIT THE FOLLOWING CONSTANTS
' Datatypes constants
Public Const BOOLEAN_TYPE%		= 1
Public Const DATE_TYPE%			= 2
Public Const EXTERNAL_FILE_PATH_TYPE%	= 3
Public Const NUMERIC_TYPE%		= 4
Public Const TEXT_TYPE%			= 5
Public Const TEXT_LIST_TYPE%		= 6
Public Const TIME_TYPE%			= 7

' Datatypes used by the different Attachments Types: ValidAttachmentBinding.ObjectType
Public Const VAB_MODELS$		= "Model"
Public Const VAB_SUBMODELS$		= "SubModel"
Public Const VAB_BUSINESSDATAOBJECTS$	= "Business Data Object"
Public Const VAB_ENTITIES_TABLES$	= "Entity / Table"
Public Const VAB_VIEWS$			= "View"
Public Const VAB_RELATIONSHIPS$ 	= "Relationship"
Public Const VAB_ATTRIBUTES_COLUMNS$	= "Attribute / Column"

' Excel constants
Public Const xlCenter% 				= -4108
Public Const xlBottom% 				= -4107
Public Const xlTop%				= -4160
Public Const xlLeft%				= -4131
Public Const xlRight%				= -4152
Public Const xlCalculationAutomatic&		= -4105
Public Const xlCalculationManual& 		= -4135
Public Const xlCalculationSemiautomatic&	= 2

Sub main
	
	On Error GoTo ErrorEnd

	DiagramManager.EnableScreenUpdateEx(FalseFalse)
	Debug.Clear
	BindProperties(False)

ErrorEnd:
	DiagramManager.EnableScreenUpdateEx(TrueTrue)

End Sub

Public Sub BindProperties(currentModelOnly As Boolean)

	Dim MyDictionary As Dictionary

	Dim MyDiagram As Diagram
	Dim MyModel As Model

	Set MyDiagram = DiagramManager.ActiveDiagram

	If Not MyDiagram Is Nothing Then

		If DICTIONARY_NAME = "" Then
			Set MyDictionary = MyDiagram.Dictionary
		Else
			Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(DICTIONARY_NAME)
		End If

		If Not (MyDictionary Is NothingThen
			
			Debug.Print
			If currentModelOnly Then
		
				Set MyModel = MyDiagram.ActiveModel
				BindModelAttachment(MyDictionary, MyModel)
				BindModelSecurity(MyDictionary, MyModel)
		
			Else
				
				For Each MyModel In MyDiagram.Models
					
					BindModelAttachment(MyDictionary, MyModel)
					BindModelSecurity(MyDictionary, MyModel)
		
				Next
		
			End If

		Else
			
			Debug.Print "Data dictionary not available!"

		End If

	Else
		
		Debug.Print "No project opened!"

	End If

End Sub

Private Sub BindModelAttachment(MyDictionary As Dictionary, MyModel As Model)
	
	Dim MyEntity As Entity
	Dim MyAttribute As AttributeObj
	Dim MyRelationship As Relationship
	Dim MyView As View
	Dim MySubModel As SubModel
	Dim MyBusinessDataObject As BusinessDataObject

	Dim MyBoundAttachment As BoundAttachment
	Dim MyAttachmentType As AttachmentType
	Dim MyAttachment As Attachment

	Debug.Print "Attachments"

	' Bind Models' Attachments
	Debug.Print "Model:" & vbTab & MyModel.Name

	For Each MyAttachmentType In MyDictionary.AttachmentTypes
		
		If IsMatching(MyAttachmentType.Name, MODELS) Then
			
			For Each MyAttachment In MyAttachmentType.Attachments

				MyModel.BoundAttachments.Add(MyAttachment.ID)

			Next

		End If

	Next

	' Bind Submodels' Attachments
	For Each MySubModel In MyModel.SubModels
		
		Debug.Print "Submodel:" & vbTab & MySubModel.Name

		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			
			If IsMatching(MyAttachmentType.Name, SUBMODELS) Then
				
				For Each MyAttachment In MyAttachmentType.Attachments
	
					Debug.Print "[" & MyAttachmentType.Name & "]" & vbTab & "Submodel:" & vbTab & MySubModel.Name
					MySubModel.BoundAttachments.Add(MyAttachment.ID)
	
				Next

			End If

		Next

	Next

	' Bind Entities' Attachments
	For Each MyEntity In MyModel.Entities
		
		Debug.Print IIf(MyModel.Logical, "Entity:" & vbTab & MyEntity.EntityName, "Table:" & vbTab & MyEntity.TableName)

		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			
			If IsMatching(MyAttachmentType.NameIIf(MyModel.Logical, ENTITIES, TABLES)) Then
				
				For Each MyAttachment In MyAttachmentType.Attachments
	
					MyEntity.BoundAttachments.Add(MyAttachment.ID)
	
				Next

			End If

		Next

		' Bind Attributes' Attachments
		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			
			If IsMatching(MyAttachmentType.NameIIf(MyModel.Logical, ATTRIBUTES, COLUMNS)) Then
	
				For Each MyAttribute In MyEntity.Attributes
	
					Debug.Print "[" & MyAttachmentType.Name & "]" & vbTab & IIf(MyModel.Logical, "Attribute:" & vbTab & MyAttribute.AttributeName, "Column:" & vbTab & MyAttribute.ColumnName)

					For Each MyAttachment In MyAttachmentType.Attachments
	
						MyAttribute.BoundAttachments.Add(MyAttachment.ID)
	
					Next

				Next
	
			End If

		Next

	Next

	' Bind Relationships' Attachments
	For Each MyRelationship In MyModel.Relationships
		
		Debug.Print "Relationship:" & vbTab & MyRelationship.Name

		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			
			If IsMatching(MyAttachmentType.Name, RELATIONSHIPS) Then
				
				For Each MyAttachment In MyAttachmentType.Attachments
	
					MyRelationship.BoundAttachments.Add(MyAttachment.ID)
	
				Next

			End If

		Next

	Next

	' Bind Views' Attachments
	For Each MyView In MyModel.Views
		
		Debug.Print "View:" & vbTab & MyView.Name

		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			
			If IsMatching(MyAttachmentType.Name, VIEWS) Then
				
				For Each MyAttachment In MyAttachmentType.Attachments
	
					MyView.BoundAttachments.Add(MyAttachment.ID)
	
				Next

			End If

		Next

	Next

	' Bind Business Data Objects' Attachments
	For Each MyBusinessDataObject In MyModel.BusinessDataObjects
		
		Debug.Print "BDO:" & vbTab & IIf(MyModel.Logical, MyBusinessDataObject.LogicalName, MyBusinessDataObject.PhysicalName)

		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			
			If IsMatching(MyAttachmentType.Name, BUSINESSDATAOBJECTS) Then
				
				For Each MyAttachment In MyAttachmentType.Attachments
	
					MyBusinessDataObject.BoundAttachments.Add(MyAttachment.ID)
	
				Next

			End If

		Next

	Next

	Debug.Print

End Sub

Private Sub BindModelSecurity(MyDictionary As Dictionary, MyModel As Model)
	
	Dim MyEntity As Entity
	Dim MyAttribute As AttributeObj
	Dim MyRelationship As Relationship
	Dim MyView As View
	Dim MySubModel As SubModel
	Dim MyBusinessDataObject As BusinessDataObject

	Dim MyBoundAttachment As BoundAttachment
	Dim MySecurityType As SecurityType
	Dim MySecurityProperty As SecurityProperty

	Debug.Print "Security"

	' Bind Models' Data Security Infomartion
	Debug.Print "Model:" & vbTab & MyModel.Name

	For Each MySecurityType In MyDictionary.SecurityTypes
		
		If IsMatching(MySecurityType.Name, MODELS) Then
			
			For Each MySecurityProperty In MySecurityType.SecurityProperties

				MyModel.BoundSecurityProperties.Add(MySecurityProperty.ID)

			Next

		End If

	Next

	' Bind Submodels' Data Security Infomartion
	For Each MySubModel In MyModel.SubModels
		
		Debug.Print "Submodel:" & vbTab & MySubModel.Name

		For Each MySecurityType In MyDictionary.SecurityTypes
			
			If IsMatching(MySecurityType.Name, SUBMODELS) Then
				
				Debug.Print "[" & MySecurityType.Name & "]" & vbTab & "Submodel:" & vbTab & MySubModel.Name

				For Each MySecurityProperty In MySecurityType.SecurityProperties
	
					MySubModel.BoundSecurityProperties.Add(MySecurityProperty.ID)
	
				Next

			End If

		Next

	Next

	' Bind Entities' Data Security Infomartion
	For Each MyEntity In MyModel.Entities
		
		Debug.Print IIf(MyModel.Logical, "Entity:" & vbTab & MyEntity.EntityName, "Table:" & vbTab & MyEntity.TableName)

		For Each MySecurityType In MyDictionary.SecurityTypes
			
			If IsMatching(MySecurityType.NameIIf(MyModel.Logical, ENTITIES, TABLES)) Then
				
				For Each MySecurityProperty In MySecurityType.SecurityProperties
	
					MyEntity.BoundSecurityProperties.Add(MySecurityProperty.ID)
	
				Next

			End If

		Next

		' Bind Attributes' Data Security Infomartion
		For Each MySecurityType In MyDictionary.SecurityTypes
			
			If IsMatching(MySecurityType.NameIIf(MyModel.Logical, ATTRIBUTES, COLUMNS)) Then
	
				For Each MyAttribute In MyEntity.Attributes
	
					Debug.Print "[" & MySecurityType.Name & "]" & vbTab & IIf(MyModel.Logical, "Attribute:" & vbTab & MyAttribute.AttributeName, "Column:" & vbTab & MyAttribute.ColumnName)

					For Each MySecurityProperty In MySecurityType.SecurityProperties
	
						MyAttribute.BoundSecurityProperties.Add(MySecurityProperty.ID)
	
					Next

				Next
	
			End If

		Next

	Next

	' Bind Views' Data Security Infomartion
	For Each MyView In MyModel.Views
		
		Debug.Print "View:" & vbTab & MyView.Name

		For Each MySecurityType In MyDictionary.SecurityTypes
			
			If IsMatching(MySecurityType.Name, VIEWS) Then
				
				For Each MySecurityProperty In MySecurityType.SecurityProperties
	
					MyView.BoundSecurityProperties.Add(MySecurityProperty.ID)
	
				Next

			End If

		Next

	Next

	' Bind Business Data Objects' Data Security Infomartion
	For Each MyBusinessDataObject In MyModel.BusinessDataObjects
		
		Debug.Print "BDO:" & vbTab & IIf(MyModel.Logical, MyBusinessDataObject.LogicalName, MyBusinessDataObject.PhysicalName)

		For Each MySecurityType In MyDictionary.SecurityTypes
			
			If IsMatching(MySecurityType.Name, BUSINESSDATAOBJECTS) Then
				
				For Each MySecurityProperty In MySecurityType.SecurityProperties
	
					MyBusinessDataObject.BoundSecurityProperties.Add(MySecurityProperty.ID)
	
				Next

			End If

		Next

	Next

	Debug.Print

End Sub

Public Function IsMatching(theAttachmentType$, theObjectType$) As Boolean
	
	Dim rc As Boolean, i%
	Dim names$()

	rc = UCase(theObjectType) = UCase(theAttachmentType)

	If Not rc Then

		names = Split(theAttachmentType, DELIMITER)
		For i = LBound(names) To UBound(names)
			
			rc = (UCase(names(i)) = UCase(theObjectType))

			If rc Then
				
				Exit For

			End If

		Next i

	End If

	IsMatching = rc

End Function

Public Function ToImportExport(name$) As Boolean
	
	Dim rc As Boolean, i%
	Dim names$()

	rc = InStr(DELIMITER & UCase(ENTITIES) & DELIMITER & UCase(TABLES) & DELIMITER & UCase(ATTRIBUTES) & DELIMITER & UCase(COLUMNS) & DELIMITER & UCase(RELATIONSHIPS) & DELIMITER & UCase(VIEWS) & DELIMITER & UCase(MODELS) & DELIMITER & UCase(SUBMODELS) & DELIMITER & UCase(BUSINESSDATAOBJECTS) & DELIMITER, DELIMITER & UCase(name) & DELIMITER) > 0

	If Not rc Then

		names = Split(name, DELIMITER)
		For i = LBound(names) To UBound(names)
			
			rc = (UCase(names(i)) = UCase(ENTITIES)) Or (UCase(names(i)) = UCase(TABLES)) Or (UCase(names(i)) = UCase(ATTRIBUTES)) Or (UCase(names(i)) = UCase(COLUMNS)) Or (UCase(names(i)) = UCase(RELATIONSHIPS)) Or (UCase(names(i)) = UCase(VIEWS)) Or (UCase(names(i)) = UCase(MODELS)) Or (UCase(names(i)) = UCase(SUBMODELS)) Or (UCase(names(i)) = UCase(BUSINESSDATAOBJECTS))

			If rc Then
				
				Exit For

			End If

		Next i

	End If

	ToImportExport = rc

End Function

Public Sub FilterTypes(ByRef MyAttachmentType As AttachmentType, sValue$)
	
	Dim MyValidAttachmentBinding As ValidAttachmentBinding
	Dim rc As Boolean, i%, sType$
	Dim names$()

	' Remove the existing bindings
	For Each MyValidAttachmentBinding In MyAttachmentType.ValidAttachmentBindings
		
		MyAttachmentType.ValidAttachmentBindings.Remove(MyValidAttachmentBinding.ID)

	Next

	sType = GetVABType(sValue)

	If sType <> "" Then
		
		MyAttachmentType.ValidAttachmentBindings.Add(sType)

	Else
		
		names = Split(sValue, DELIMITER)
		For i = LBound(names) To UBound(names)
			
			sType = GetVABType(names(i))

			If sType <> "" Then
			
				MyAttachmentType.ValidAttachmentBindings.Add(sType)
				Debug.Print "VAB:" & vbTab & MyAttachmentType.Name & vbTab & vbTab & sType

			End If

		Next i

	End If

	MyAttachmentType.ValidAttachmentBindings.Remove("Universal Mappings")	'	The last one remaining from the remove all at the start; as we don't handle Universal Mappings, we remove it after adding the one(s) we need

End Sub

Private Function GetVABType$(sType$)
	
	Dim rc$

	rc = ""

	Select Case UCase(sType)
		Case UCase(ENTITIES), UCase(TABLES)
			rc = VAB_ENTITIES_TABLES
		Case UCase(ATTRIBUTES), UCase(COLUMNS)
			rc = VAB_ATTRIBUTES_COLUMNS
		Case UCase(RELATIONSHIPS)
			rc = VAB_RELATIONSHIPS
		Case UCase(VIEWS)
			rc = VAB_VIEWS
		Case UCase(MODELS)
			rc = VAB_MODELS
		Case UCase(SUBMODELS)
			rc = VAB_SUBMODELS
		Case UCase(BUSINESSDATAOBJECTS)
			rc = VAB_BUSINESSDATAOBJECTS
	End Select

	GetVABType = rc

End Function

wGeneratePropertiesToExcel.bas

'#Language "WWB-COM"
''MACRO TITLE: wGenerate Properties to Excel
' MACRO VERSION: 3.0
'This macro exports specific Attachments and Data Security Information
'	for Entities, Tables, Attributes, Columns, Relationships, Views,
'	Models, Submodels & Business Data Objects
'
' Dependencies
'	wBindPropertiesToERObjects.bas
'	Excel
'
' Release notes
' 3.0: Export specific Data Security Information
' 2.0: Export specific Attachments Types
' 1.0: Initial version
'---------------------------------------------------------------------------
'#Uses "wBindPropertiesToERObjects.bas"

Option Explicit

Private Const TITLE$ = "wGenerate Properties to Excel"
Private Const TIMESTAMPED As Boolean = True

Sub Main

	Dim MyDiagram As Diagram
	Dim MyDictionary As Dictionary
	Dim dictionary_list$()
	
	Dim MyAttachmentType As AttachmentType
	Dim MyAttachment As Attachment
	Dim MySecurityType As SecurityType
	Dim MySecurityProperty As SecurityProperty

	' Excel variables
	Dim wb As Object
	Dim sheet As Object
	Dim excel As Object

	Dim MyListMember As ListMember
	Dim sList$
	Dim curRow%

	Debug.Clear

	'Get the current diagram.
	Set MyDiagram = DiagramManager.ActiveDiagram

	If Not MyDiagram Is Nothing Then
		' Excel
		Set excel = CreateObject("excel.application")
	
		PrintHeader(excel, wb, sheet)
		' Excel optimization
		excel.Application.ScreenUpdating = False
		excel.Application.EnableAnimations = False
		excel.Application.Calculation = xlCalculationManual
		sheet.DisplayPageBreaks = False
	
		curRow = 2
	
		If init_dictionary_list(MyDiagram, dictionary_list) Then
			
			Set MyDictionary = MyDiagram.Dictionary
	
		Else
			
			Begin Dialog UserDialog 550,130,TITLE ' %GRID:10,7,1,1
				Text 30,21,120,14,"Select Dictionary: ",.Text3,1
				DropListBox 170,18,360,112,dictionary_list(),.dictionary_select
				OKButton 20,105,110,21
				CancelButton 420,105,110,21
			End Dialog
	
			Dim dlg As UserDialog
	
			If Dialog(dlg) = -1 Then
				
				If dictionary_list(dlg.dictionary_select) = "Local" Then
					
					Set MyDictionary = MyDiagram.Dictionary
	
				Else
					
					Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(dictionary_list(dlg.dictionary_select))
	
				End If
	
			Else
				
				Exit Sub
	
			End If
	
		End If
		
		If Not MyDictionary Is Nothing Then
	
			LogIt "Dictionary: " & MyDictionary.Name
	
			' Get all attachments
			For Each MyAttachmentType In MyDictionary.AttachmentTypes
				
				' Export only the needed attachments
				If ToImportExport(MyAttachmentType.NameThen
					
					For Each MyAttachment In MyAttachmentType.Attachments
						
			'			LogIt MyAttachmentType.Name & " / " & MyAttachment.Name
						sheet.Cells(curRow, 1).Value = MyAttachmentType.Name
						sheet.Cells(curRow, 2).Value = MyAttachment.Name
						sheet.Cells(curRow, 3).Value = MyAttachment.Description
						sheet.Cells(curRow, 4).Value = MyAttachment.Datatype
						sheet.Cells(curRow, 5).Value = MyAttachment.ValueDefault
		
						Select Case MyAttachment.Datatype
		
							Case TEXT_LIST_TYPE
								sList = ""
		
								For Each MyListMember In MyAttachment.TextList
		
									sList += MyListMember.Text & ","
		
								Next MyListMember
		
								If Right(sList, 1) = "," Then
									
									sList = Left(sList, Len(sList) - 1)
		
								End If
		
								sheet.Cells(curRow, 6).Value = sList
		
						End Select
			
		'				XLColumns4Attachments(MyAttachmentType.Name & "\" & MyAttachment.Name) = curCol
						LogIt MyAttachmentType.Name & "\" & MyAttachment.Name
						curRow += 1
		
					Next MyAttachment
	
				Else
					
					LogIt "SKIPPED:" & vbTab & MyAttachmentType.Name
	
				End If
	
			Next MyAttachmentType
		
			curRow = 2
			' Select the Data Security Information sheet
			Set sheet = wb.worksheets(XL_TAB_SECURITY)
			sheet.Activate
	
			' Get all data security information
			For Each MySecurityType In MyDictionary.SecurityTypes
				
				' Export only the needed data security information
				If ToImportExport(MySecurityType.NameThen
					
					For Each MySecurityProperty In MySecurityType.SecurityProperties
						
			'			LogIt MySecurityType.Name & " / " & MySecurityProperty.Name
						sheet.Cells(curRow, 1).Value = MySecurityType.Name
						sheet.Cells(curRow, 2).Value = MySecurityProperty.Name
						sheet.Cells(curRow, 3).Value = MySecurityProperty.Description
						sheet.Cells(curRow, 4).Value = MySecurityProperty.Datatype
						sheet.Cells(curRow, 5).Value = MySecurityProperty.ValueDefault
		
						Select Case MySecurityProperty.Datatype
		
							Case TEXT_LIST_TYPE
								sList = ""
		
								For Each MyListMember In MySecurityProperty.TextList
		
									sList += MyListMember.Text & ","
		
								Next MyListMember
		
								If Right(sList, 1) = "," Then
									
									sList = Left(sList, Len(sList) - 1)
		
								End If
		
								sheet.Cells(curRow, 6).Value = sList
		
						End Select
			
		'				XLColumns4Attachments(MyAttachmentType.Name & "\" & MyAttachment.Name) = curCol
						LogIt MySecurityType.Name & "\" & MySecurityProperty.Name
						curRow += 1
		
					Next MySecurityProperty
	
				Else
					
					LogIt "SKIPPED:" & vbTab & MySecurityType.Name
	
				End If
	
			Next MySecurityType
	
			Debug.Print
			LogIt "Export completed"
		
			excel.Visible = True
			excel.Application.ScreenUpdating = True
			excel.Application.EnableAnimations = True
			excel.Application.Calculation = xlCalculationAutomatic
	'		sheet.DisplayPageBreaks = True
			AutofitAllUsed(excel)
			' Select the Attachment sheet
			Set sheet = wb.worksheets(XL_TAB_ATTACHMENT)
			sheet.Activate
			AutofitAllUsed(excel)
	'		sheet.Rows("1:1").RowHeight = 14.4 '.EntireRow.AutoFit
	
			MsgBox "Export completed !", vbInformation, TITLE

		End If

	Else
		
		MsgBox "No project opened!", vbExclamation, TITLE

	End If
	
End Sub

Private Function PrefixDT(txt As StringAs String
	If TIMESTAMPED Then
		PrefixDT = CStr(Now) & Chr(9) & txt
	Else
		PrefixDT = txt
	End If
End Function

Private Sub LogIt(ByVal txt As String)

	Debug.Print PrefixDT(txt)

End Sub

Private Sub PrintHeader(ByRef excel As ObjectByRef wb As ObjectByRef sheet As Object)

	Set wb = excel.workbooks.Add

	' Attachments
	Set sheet = wb.activesheet

	sheet.Name = XL_TAB_ATTACHMENT

	With sheet.range("A1:F1")
		.interior.colorindex = 15
		.font.Size = 9
		.font.Bold = True
		.horizontalalignment = xlCenter
	End With

	With excel
		With .ActiveWindow
			.SplitColumn = 1
			.SplitRow = 1
		End With
		.ActiveWindow.FreezePanes = True
	End With

	sheet.cells(1,1).Value = "Attachment Type"
	sheet.cells(1,2).Value = "Name"
	sheet.cells(1,3).Value = "Description"
	sheet.cells(1,4).Value = "Data Type"
	sheet.cells(1,5).Value = "Default value"
	sheet.cells(1,6).Value = "Text list values"

	With sheet.cells(1,4)
		.AddComment
		.Comment.Visible = False
		.Comment.Text Text:= "1 = Boolean" & vbCrLf & "2 = Date" & vbCrLf & "3 = ExternalFilePath" & vbCrLf & "4 = Numeric" & vbCrLf & "5 = Text" & vbCrLf & "6 = TextList" & vbCrLf & "7 = Time"
	End With

	With sheet.range("A:A")
		.interior.colorindex = 15
		.verticalalignment = xlBottom
		.horizontalalignment = xlLeft
		.font.Bold = True
		.font.Size = 9
	End With

	Comments_AutoSize(sheet)

	' Data Security Information
	Set sheet = wb.worksheets.Add(After:=sheet)

	sheet.Name = XL_TAB_SECURITY

	With sheet.range("A1:F1")
		.interior.colorindex = 15
		.font.Size = 9
		.font.Bold = True
		.horizontalalignment = xlCenter
	End With

	With excel
		With .ActiveWindow
			.SplitColumn = 1
			.SplitRow = 1
		End With
		.ActiveWindow.FreezePanes = True
	End With

	sheet.cells(1,1).Value = "Security Type"
	sheet.cells(1,2).Value = "Name"
	sheet.cells(1,3).Value = "Description"
	sheet.cells(1,4).Value = "Data Type"
	sheet.cells(1,5).Value = "Default value"
	sheet.cells(1,6).Value = "Text list values"

	With sheet.cells(1,4)
		.AddComment
		.Comment.Visible = False
		.Comment.Text Text:= "1 = Boolean" & vbCrLf & "2 = Date" & vbCrLf & "3 = ExternalFilePath" & vbCrLf & "4 = Numeric" & vbCrLf & "5 = Text" & vbCrLf & "6 = TextList" & vbCrLf & "7 = Time"
	End With

	With sheet.range("A:A")
		.interior.colorindex = 15
		.verticalalignment = xlBottom
		.horizontalalignment = xlLeft
		.font.Bold = True
		.font.Size = 9
	End With

	Comments_AutoSize(sheet)

	' Select the Attachment sheet
	Set sheet = wb.worksheets(XL_TAB_ATTACHMENT)
	sheet.Activate

End Sub

Private Sub AutofitAllUsed(excel As Object)
	Dim x As Long

	For x = 1 To excel.ActiveSheet.UsedRange.Columns.Count
		excel.ActiveSheet.UsedRange.Columns(x).EntireColumn.AutoFit
	Next x
End Sub

'initialize the dictionary drop down list
Function init_dictionary_list(ByRef MyDiagram As Diagram, ByRef dictionary_list$()) As Boolean

	Dim i%
	Dim MyDictionary As Dictionary

	ReDim dictionary_list$(0 To MyDiagram.EnterpriseDataDictionaries.Count)

	dictionary_list (0) = "Local"
	i = 1

	For Each MyDictionary In MyDiagram.EnterpriseDataDictionaries
		dictionary_list (i) = MyDictionary.Name
		i +=  1
	Next

	init_dictionary_list = MyDiagram.EnterpriseDataDictionaries.Count = 0

End Function

Sub Comments_AutoSize(s As Object)
	' https://www.contextures.com/xlcomments03.html
	Dim MyComments As Object
	Dim lArea As Long
	Dim lMult As Double
	Dim MaxW As Long
	Dim NewW As Long
	
	'Height adjustment factor
	 'of 1.1 seems to work ok.
	lMult = 1.1
	MaxW = 300
	NewW = 200
	
	For Each MyComments In s.Comments
	  With MyComments
		.Shape.TextFrame.AutoSize = True
		If .Shape.Width > MaxW Then
		  lArea = .Shape.Width * .Shape.Height
		  .Shape.Width = NewW
		  .Shape.Height = (lArea / NewW) * lMult
		End If
	  End With
	Next ' comment
End Sub

wReadPropertiesFromExcelWithUI.bas

'#Language "WWB-COM"
''MACRO TITLE: wRead Properties from Excel with UI
' MACRO VERSION: 3.0
'This macro imports specific Attachments and Data Security Information
'	for Entities, Tables, Attributes, Columns, Relationships, Views,
'	Models, Submodels & Business Data Objects
'
' Dependencies:
'	wBindPropertiesToERObjects.bas
'	Excel
'
' Known limitations
'	Types for Attachments & Data Security Information can NOT have common
'	names
'
' Release notes
' 3.0: Import specific Data Security Information
' 2.0: Import specific Attachments Types
' 1.0: Initial version
'---------------------------------------------------------------------------
'#Uses "wBindPropertiesToERObjects.bas"

Option Explicit

Private Const TITLE$ = "wRead Properties from Excel"

Dim XLfile$
Dim lCurRow%

Sub Main

	Dim excel As Object
	Dim MyDiagram As Diagram
	Dim MyDictionary As Dictionary
	Dim lNbAttachmentsManaged&, lNbSecurityPropertiesManaged&
	Dim dictionary_list$()
	Debug.Clear

	Set MyDiagram = DiagramManager.ActiveDiagram

	If Not MyDiagram Is Nothing Then

		Begin Dialog UserDialog 550,217,TITLE,.DialogFunc ' %GRID:10,7,1,1
			Text 30,21,120,14,"Select Dictionary: ",.Text3,1
			DropListBox 170,18,360,112,dictionary_list(),.dictionary_select
			GroupBox 20,56,510,98,"Excel spreadsheet",.gbPath
			Text 30,84,50,14,"Path: ",.Text1,1
			TextBox 90,83,360,21,.Path
			PushButton 460,84,60,21,"Browse",.Browse
			PushButton 350,119,170,28,"Generate a Sample Sheet",.SampleSheet
			CheckBox 30,161,490,14,"Bind attachments to ER Objects",.cbBind
			OKButton 20,189,110,21
			CancelButton 420,189,110,21
		End Dialog
	
		Dim dlg As UserDialog
	
		init_dictionary_list(MyDiagram, dictionary_list)
	
		start_dialog:
		'dlg.Path = "C:\Users\William\Documents\ERStudio Data Architect 19.3\tests\GIM_Attachments.xlsx"
	
		'start dialog
		If Dialog(dlg) = -1 Then
	
			If dictionary_list(dlg.dictionary_select) = "Local" Then
				Set MyDictionary = MyDiagram.Dictionary
			Else
				Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(dictionary_list(dlg.dictionary_select))
			End If
	
			'initialize excel object and make visible
			Set excel = CreateObject("Excel.Application")
	
			'this Error Is For an errant file path, Dialog will be restarted
			On Error GoTo Error_open
	
			XLfile = dlg.Path
			excel.workbooks.Open XLfile
		
			On Error GoTo Error_unknown
	
			DiagramManager.EnableScreenUpdateEx(FalseFalse)
	
			lNbAttachmentsManaged = ImportAttachments(excel, MyDictionary)
			lNbSecurityPropertiesManaged = ImportSecurities(excel, MyDictionary)
	
			If ((lNbAttachmentsManaged > 0) Or (lNbSecurityPropertiesManaged > 0)) And dlg.cbBind Then
				
				BindProperties(False)
	
			End If
	
			DiagramManager.EnableScreenUpdateEx(TrueTrue)
	
			excel.Quit()
			MsgBox ("ERObjects properties imported" & vbCrLf & vbCrLf & lNbAttachmentsManaged & " attachment" & If(lNbAttachmentsManaged > 1, "s", "") & " managed" & vbCrLf & lNbSecurityPropertiesManaged & " security propert" & If(lNbSecurityPropertiesManaged > 1, "ies", "y") & " managed", vbInformation, TITLE)
			Debug.Print
			Debug.Print lNbAttachmentsManaged & " attachment" & If(lNbAttachmentsManaged > 1, "s", "") & " managed"
			Debug.Print lNbSecurityPropertiesManaged & " security propert" & If(lNbSecurityPropertiesManaged > 1, "ies", "y") & " managed"
	
			Exit Sub
		
			Error_open:
				MsgBox("Please enter a valid path.", vbExclamation, TITLE)
				GoTo start_dialog
	
			Error_unknown:
				MsgBox(Err.Description & If(lCurRow > 1, vbCrLf & vbCrLf & "Last Excel row used: " & lCurRow, ""), vbExclamation, TITLE)
			
				If Not excel Is Nothing Then
					excel.Quit()
				End If
	
				DiagramManager.EnableScreenUpdateEx(TrueTrue)
	
		End If

	Else
		
		MsgBox "No project opened!", vbExclamation, TITLE

	End If

End Sub

'initialize the dictionary drop down list
Sub init_dictionary_list(ByRef MyDiagram As Diagram, ByRef dictionary_list$())

	Dim i%
	Dim MyDictionary As Dictionary

	ReDim dictionary_list$(0 To MyDiagram.EnterpriseDataDictionaries.Count)

	dictionary_list (0) = "Local"
	i = 1

	For Each MyDictionary In MyDiagram.EnterpriseDataDictionaries
		dictionary_list (i) = MyDictionary.Name
		i = i + 1
	Next

End Sub

Private Function ImportAttachments%(ByRef ex As VariantByRef MyDictionary As Dictionary)

	Dim sheet As Object
	Dim range As Object

	Dim sValue$, iValue%, sDefault$
	Dim lNbAttachments&, lNbAttachmentsManaged&

	Dim MyAttachmentType As AttachmentType
	Dim MyAttachment As Attachment
	
	Dim sLastAttachmentType$

	Dim sDescription$, dt As Date, splitted$()

	Set sheet = ex.worksheets(XL_TAB_ATTACHMENT)
	sheet.Activate
	Set range = sheet.usedrange
	range.Select
	sLastAttachmentType = ""

	ImportAttachments = 0

	lNbAttachments = range.Rows.Count
	Debug.Print "Number of attachments: " & (lNbAttachments - 1)
	lNbAttachmentsManaged = 0

	ReDim MyAttachments(lNbAttachments)

	For lCurRow = 2 To lNbAttachments
		sValue = Trim(CStr(range.Cells(lCurRow, 1).Value))
		If (sValue <> "") And ToImportExport(sValue) Then
			If (sValue <> sLastAttachmentType) Then
				Set MyAttachmentType = MyDictionary.AttachmentTypes(sValue)
				' Check if AttachmentType exists
				If MyAttachmentType Is Nothing Then
					' Attachment type not found, we create it
					Set MyAttachmentType = MyDictionary.AttachmentTypes.Add(sValue, "Imported from file: " & XLfile)
					' Filter types: ValidAttachmentBinding.ObjectType
					FilterTypes(MyAttachmentType, sValue)
				End If
				sLastAttachmentType = sValue
			End If

			sValue = Trim(CStr(range.Cells(lCurRow, 2).Value))
			If (sValue <> "") Then
				Set MyAttachment = MyAttachmentType.Attachments(sValue)
				' Check if Attachment exists
				If MyAttachment Is Nothing Then
					' Attachment not found, we create it
					Set MyAttachment = MyAttachmentType.Attachments.Add(sValue,  "Imported from file: " & XLfile, "", TEXT_TYPE)
					Debug.Print "Attachment created: " & MyAttachmentType.Name & " \ " & MyAttachment.Name
				Else
					Debug.Print "Attachment found: " & MyAttachmentType.Name & " \ " & MyAttachment.Name
				End If

				lNbAttachmentsManaged += 1

				sDescription = Trim(CStr(range.Cells(lCurRow, 3).Value))

				If sDescription <> "" Then
				
					MyAttachment.Description = sDescription

				End If

				iValue = CInt(Trim(range.Cells(lCurRow, 4).Value))

				MyAttachment.Datatype = iValue

				sValue = Trim(CStr(range.Cells(lCurRow, 6).Value))

				If sValue <> "" Then
				
					splitted = Split(sValue, ",")

					For Each sValue In splitted

						MyAttachment.TextList.Add(sValue)

					Next sValue

				End If

				sDefault = Trim(CStr(range.Cells(lCurRow, 5).Value))

				If (sDefault <> "") Then
					
					' Convert/Format the value to a string
					Select Case iValue

					Case NUMERIC_TYPE
						
						sDefault = CStr(CInt(sDefault))

					Case DATE_TYPE
						
						dt = CStr(CDate(sDefault))
						sDefault = Format(dt, "MM/DD/YYYY")

					Case TIME_TYPE
						
						dt = CStr(CDate(sDefault)) ' Type checking through casting
						sDefault = Format(dt, "hh:nn:ssAMPM") ' Expected ER/Studio format

					Case BOOLEAN_TYPE
						
						sDefault = CStr(CBool(sDefault))

					End Select

					MyAttachment.ValueDefault = sDefault

				End If

			End If

		End If
	Next lCurRow

	ImportAttachments = lNbAttachmentsManaged

End Function

Sub PrintSampleSheet()
	Dim sample As Object
	Dim wb, ws As Variant

	Set sample = CreateObject("excel.application")
	sample.visible = True

	Set wb = sample.workbooks.Add
	Set ws = wb.activesheet

	PrintHeader(sample, wb, ws)

	ws.Cells(2, 1).Value = "Tables"
	ws.Cells(2, 2).Value = "Attachment 1"
	ws.Cells(2, 3).Value = "A description"
	ws.Cells(2, 4).Value = TEXT_TYPE
	ws.Cells(2, 5).Value = "Default value"

	ws.Cells(3, 1).Value = "Tables"
	ws.Cells(3, 2).Value = "Attachment 2"
	ws.Cells(3, 3).Value = "Another description"
	ws.Cells(3, 4).Value = TEXT_LIST_TYPE
	ws.Cells(3, 5).Value = "Second item"
	ws.Cells(3, 6).Value = "First item,Second item,Third item"

	ws.Cells(4, 1).Value = "Entities"
	ws.Cells(4, 2).Value = "Attachment 1"
	ws.Cells(4, 3).Value = "My entity property description"
	ws.Cells(4, 4).Value = TEXT_TYPE

	ws.Cells(5, 1).Value = "Attributes|Columns"
	ws.Cells(5, 2).Value = "Attachment 1"
	ws.Cells(5, 3).Value = "My Attribute or Column property description"
	ws.Cells(5, 4).Value = TEXT_TYPE

	ws.Cells(6, 1).Value = "Attributes|Columns"
	ws.Cells(6, 2).Value = "Attachment 2"
	ws.Cells(6, 3).Value = "My Attribute or Column property description"
	ws.Cells(6, 4).Value = TEXT_TYPE

	ws.Cells(7, 1).Value = "..."
	ws.Cells(7, 2).Value = "..."
	ws.Cells(7, 3).Value = "..."
	ws.Cells(7, 4).Value = "..."
	ws.Cells(7, 5).Value = "..."
	ws.Cells(7, 6).Value = "..."

	AutofitAllUsed(sample)

	' Select the Data Security Information sheet
	Set ws = wb.worksheets(XL_TAB_SECURITY)
	ws.Activate

	ws.Cells(2, 1).Value = "Tables|Entities|Attributes|Columns"
	ws.Cells(2, 2).Value = "Property 1"
	ws.Cells(2, 3).Value = "A description"
	ws.Cells(2, 4).Value = TEXT_TYPE
	ws.Cells(2, 5).Value = "Default value"

	ws.Cells(3, 1).Value = "Tables|Entities|Attributes|Columns"
	ws.Cells(3, 2).Value = "Property 2"
	ws.Cells(3, 3).Value = "Another description"
	ws.Cells(3, 4).Value = TEXT_LIST_TYPE
	ws.Cells(3, 5).Value = "Second item"
	ws.Cells(3, 6).Value = "First item,Second item,Third item"

	ws.Cells(4, 1).Value = "Relationships"
	ws.Cells(4, 2).Value = "Attachment 1"
	ws.Cells(4, 3).Value = "My entity property description"
	ws.Cells(4, 4).Value = TEXT_TYPE

	ws.Cells(5, 1).Value = "..."
	ws.Cells(5, 2).Value = "..."
	ws.Cells(5, 3).Value = "..."
	ws.Cells(5, 4).Value = "..."
	ws.Cells(5, 5).Value = "..."
	ws.Cells(5, 6).Value = "..."

	AutofitAllUsed(sample)

	' Select the Attachments sheet
	Set ws = wb.worksheets(XL_TAB_ATTACHMENT)
	ws.Activate

	Debug.Print "Sample generated"
	MsgBox "Sample generated", vbInformation, TITLE
End Sub

Private Function DialogFunc(DlgItem$, Action%, SuppValue&) As Boolean
	Select Case Action%
	Case 1 ' Dialog box initialization
		
		DlgValue("cbBind", True)

	Case 2 ' Value changing or button pressed
		
		If DlgItem = "Browse" Then
			'browse to excel file if used pushes browse button.  Put path in text box.
			DlgText "path", GetFilePath(,"All Excel Files (*.xlsx;*.xls;*.xlsm)|*.xlsx;*.xls;*.xlsm|Excel Workbook (*.xlsx)|*.xlsx|Excel Macro-enabled Workbook (*.xslm)|*.xslm|Excel 97-2003 Workbook (*.xls)|*.xls|All Files (*.*)|*.*",,"Open SpreadSheet", 0)
			DialogFunc = True
		ElseIf DlgItem = "SampleSheet" Then
			PrintSampleSheet
			DialogFunc = True
		ElseIf DlgItem = "OK" And DlgText("path") = "" Then
			'don't exit dialog if a path is not specified
			MsgBox("Please enter a valid path.", vbExclamation, TITLE)
			DialogFunc = True
		End If
		Rem DialogFunc = True ' Prevent button press from closing the dialog box

	Case 3 ' TextBox or ComboBox text changed
	Case 4 ' Focus changed
	Case 5 ' Idle
		Rem DialogFunc = True ' Continue getting idle actions
	Case 6 ' Function key
	End Select
End Function

Private Sub AutofitAllUsed(excelObj)
	Dim x As Long

	For x = 1 To excelObj.ActiveSheet.UsedRange.Columns.Count
		excelObj.ActiveSheet.UsedRange.Columns(x).EntireColumn.AutoFit
	Next x
End Sub

Private Sub PrintHeader(excel As Object, wb As Variant, sheet As Variant)

	sheet.Name = "Attachments"

	With sheet.range("A1:F1")
		.interior.colorindex = 15
		.font.Size = 9
		.font.Bold = True
		.horizontalalignment = xlCenter
	End With

	With excel
		With .ActiveWindow
			.SplitColumn = 1
			.SplitRow = 1
		End With
		.ActiveWindow.FreezePanes = True
	End With

	sheet.cells(1,1).Value = "Attachment Type"
	sheet.cells(1,2).Value = "Name"
	sheet.cells(1,3).Value = "Description"
	sheet.cells(1,4).Value = "Data Type"
	sheet.cells(1,5).Value = "Default value"
	sheet.cells(1,6).Value = "Text list values"

	With sheet.cells(1,4)
		.AddComment
		.Comment.Visible = False
		.Comment.Text Text:= "1 = Boolean" & vbCrLf & "2 = Date" & vbCrLf & "3 = ExternalFilePath" & vbCrLf & "4 = Numeric" & vbCrLf & "5 = Text" & vbCrLf & "6 = TextList" & vbCrLf & "7 = Time"
	End With

	With sheet.range("A:A")
		.interior.colorindex = 15
		.verticalalignment = xlBottom
		.horizontalalignment = xlLeft
		.font.Bold = True
		.font.Size = 9
	End With

	Comments_AutoSize(sheet)

	' Data Security Information
	Set sheet = wb.worksheets.Add(After:=sheet)

	sheet.Name = XL_TAB_SECURITY

	With sheet.range("A1:F1")
		.interior.colorindex = 15
		.font.Size = 9
		.font.Bold = True
		.horizontalalignment = xlCenter
	End With

	With excel
		With .ActiveWindow
			.SplitColumn = 1
			.SplitRow = 1
		End With
		.ActiveWindow.FreezePanes = True
	End With

	sheet.cells(1,1).Value = "Security Type"
	sheet.cells(1,2).Value = "Name"
	sheet.cells(1,3).Value = "Description"
	sheet.cells(1,4).Value = "Data Type"
	sheet.cells(1,5).Value = "Default value"
	sheet.cells(1,6).Value = "Text list values"

	With sheet.cells(1,4)
		.AddComment
		.Comment.Visible = False
		.Comment.Text Text:= "1 = Boolean" & vbCrLf & "2 = Date" & vbCrLf & "3 = ExternalFilePath" & vbCrLf & "4 = Numeric" & vbCrLf & "5 = Text" & vbCrLf & "6 = TextList" & vbCrLf & "7 = Time"
	End With

	With sheet.range("A:A")
		.interior.colorindex = 15
		.verticalalignment = xlBottom
		.horizontalalignment = xlLeft
		.font.Bold = True
		.font.Size = 9
	End With

	Comments_AutoSize(sheet)

	' Select the Attachment sheet
	Set sheet = wb.worksheets(XL_TAB_ATTACHMENT)
	sheet.Activate

End Sub

Sub Comments_AutoSize(s As Object)
	' https://www.contextures.com/xlcomments03.html
	Dim MyComments As Object
	Dim lArea As Long
	Dim lMult As Double
	Dim MaxW As Long
	Dim NewW As Long
	
	'Height adjustment factor
	 'of 1.1 seems to work ok.
	lMult = 1.1
	MaxW = 300
	NewW = 200
	
	For Each MyComments In s.Comments
	  With MyComments
		.Shape.TextFrame.AutoSize = True
		If .Shape.Width > MaxW Then
		  lArea = .Shape.Width * .Shape.Height
		  .Shape.Width = NewW
		  .Shape.Height = (lArea / NewW) * lMult
		End If
	  End With
	Next ' comment
End Sub

Private Function ImportSecurities%(ByRef ex As VariantByRef MyDictionary As Dictionary)

	Dim sheet As Object
	Dim range As Object

	Dim lNbSecurityProperties&

	Dim sValue$, iValue%, sDefault$
	Dim lNbSecuritiesManaged&

	Dim MySecurityType As SecurityType
	Dim MySecurityProperty As SecurityProperty

	Dim sLastSecurityType$

	Dim sDescription$, dt As Date, splitted$()

	Set sheet = ex.worksheets(XL_TAB_SECURITY)
	sheet.Activate
	Set range = sheet.usedrange
	range.Select
	sLastSecurityType = ""

	ImportSecurities = 0

	lNbSecurityProperties = range.Rows.Count
	Debug.Print "Number of data security information: " & (lNbSecurityProperties - 1)
	lNbSecuritiesManaged = 0

	For lCurRow = 2 To lNbSecurityProperties
		sValue = Trim(CStr(range.Cells(lCurRow, 1).Value))
		If (sValue <> "") And ToImportExport(sValue) Then
			If (sValue <> sLastSecurityType) Then
				Set MySecurityType = MyDictionary.SecurityTypes(sValue)
				' Check if Security Type exists
				If MySecurityType Is Nothing Then
					' Security type not found, we create it
					Set MySecurityType = MyDictionary.SecurityTypes.Add(sValue, "Imported from file: " & XLfile)
				End If
				sLastSecurityType = sValue
			End If

			sValue = Trim(CStr(range.Cells(lCurRow, 2).Value))
			If (sValue <> "") Then
				Set MySecurityProperty = MySecurityType.SecurityProperties(sValue)
				' Check if Security Property exists
				If MySecurityProperty Is Nothing Then
					' Security Property not found, we create it
					Set MySecurityProperty = MySecurityType.SecurityProperties.Add(sValue,  "Imported from file: " & XLfile, "", TEXT_TYPE)
					Debug.Print "Security Property created: " & MySecurityType.Name & " \ " & MySecurityProperty.Name
				Else
					Debug.Print "Security Property found: " & MySecurityType.Name & " \ " & MySecurityProperty.Name
				End If

				lNbSecuritiesManaged += 1

				sDescription = Trim(CStr(range.Cells(lCurRow, 3).Value))

				If sDescription <> "" Then
				
					MySecurityProperty.Description = sDescription

				End If

				iValue = CInt(Trim(range.Cells(lCurRow, 4).Value))

				MySecurityProperty.Datatype = iValue

				sValue = Trim(CStr(range.Cells(lCurRow, 6).Value))

				If sValue <> "" Then
				
					splitted = Split(sValue, ",")

					For Each sValue In splitted

						MySecurityProperty.TextList.Add(sValue)

					Next sValue

				End If

				sDefault = Trim(CStr(range.Cells(lCurRow, 5).Value))

				If (sDefault <> "") Then
					
					' Convert/Format the value to a string
					Select Case iValue

					Case NUMERIC_TYPE
						
						sDefault = CStr(CInt(sDefault))

					Case DATE_TYPE
						
						dt = CStr(CDate(sDefault))
						sDefault = Format(dt, "MM/DD/YYYY")

					Case TIME_TYPE
						
						dt = CStr(CDate(sDefault)) ' Type checking through casting
						sDefault = Format(dt, "hh:nn:ssAMPM") ' Expected ER/Studio format

					Case BOOLEAN_TYPE
						
						sDefault = CStr(CBool(sDefault))

					End Select

					MySecurityProperty.ValueDefault = sDefault

				End If

			End If

		End If
	Next lCurRow

	ImportSecurities = lNbSecuritiesManaged

End Function

wReadPropertiesFromExcel.bas

⚠️ You need to update the path to the Excel workbook (Line 26).

'#Language "WWB-COM"
''MACRO TITLE: wRead Properties from Excel
' MACRO VERSION: 3.0
'This macro imports specific Attachments for Entities, Tables, Attributes,
'	Columns, Relationships, Views, Models, Submodels & Business Data Objects
'
' Dependencies
'	wBindPropertiesToERObjects.bas
'	Excel
'
' Known limitations
'	Types for Attachments & Data Security Information can NOT have common
'	names
'
' Release notes
' 3.0: Import specific Data Security Information
' 2.0: Import specific Attachments Types
' 1.0: Initial version
'---------------------------------------------------------------------------
'#Uses "wBindPropertiesToERObjects.bas"

Option Explicit

Private Const TITLE$ = "wRead Properties from Excel"

Private Const EXCEL_FILE$ = "C:\Users\William\Documents\ERStudio Data Architect 20.1\Tests\default_attachments_V3.xlsx"	'	Path to the workbook with the attachments list
Private Const BIND_PROPERTIES_TO_EROBJECTS = True

Dim lCurRow%

Sub Main
	
	Dim excel As Object

	Dim MyDiagram As Diagram
	Dim MyDictionary As Dictionary

	Dim lNbAttachmentsManaged&, lNbSecurityPropertiesManaged&
	Debug.Clear

	Set MyDiagram = DiagramManager.ActiveDiagram

	If Not MyDiagram Is Nothing Then

		start_dialog:
	
		If DICTIONARY_NAME = "" Then
			Set MyDictionary = MyDiagram.Dictionary
		Else
			Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(DICTIONARY_NAME)
		End If
	
		If Not MyDictionary Is Nothing Then
	
			'initialize excel object and make visible
			Set excel = CreateObject("Excel.Application")
		
			'this Error Is For an errant file path, Dialog will be restarted
			On Error GoTo Error_open
		
			excel.workbooks.Open EXCEL_FILE
		
			On Error GoTo Error_unknown
		
			DiagramManager.EnableScreenUpdateEx(FalseFalse)
		
			lNbAttachmentsManaged = ImportAttachments(excel, MyDictionary)
			lNbSecurityPropertiesManaged = ImportSecurities(excel, MyDictionary)
			lCurRow = 0
		
			If ((lNbAttachmentsManaged > 0) Or (lNbSecurityPropertiesManaged > 0)) And BIND_PROPERTIES_TO_EROBJECTS Then
				
				BindProperties(False)
		
			End If
		
			DiagramManager.EnableScreenUpdateEx(TrueTrue)
		
			excel.Quit()
			MsgBox ("ERObjects properties imported" & vbCrLf & vbCrLf & lNbAttachmentsManaged & " attachment" & If(lNbAttachmentsManaged > 1, "s", "") & " managed" & vbCrLf & lNbSecurityPropertiesManaged & " security propert" & If(lNbSecurityPropertiesManaged > 1, "ies", "y") & " managed", vbInformation, TITLE)
			Debug.Print
			Debug.Print lNbAttachmentsManaged & " attachment" & If(lNbAttachmentsManaged > 1, "s", "") & " managed"
			Debug.Print lNbSecurityPropertiesManaged & " security propert" & If(lNbSecurityPropertiesManaged > 1, "ies", "y") & " managed"
	
		Else
			
			MsgBox "Data dictionary not available!", vbExclamation, TITLE
	
		End If

	Else
		
		MsgBox "No project opened!", vbExclamation, TITLE

	End If

	Exit Sub

	Error_open:
		MsgBox("Excel file path is not valid.", vbExclamation, TITLE)
		GoTo start_dialog

	Error_unknown:
		MsgBox(Err.Description & If(lCurRow > 1, vbCrLf & vbCrLf & "Last Excel row used: " & lCurRow, ""), vbExclamation, TITLE)
	
		If Not excel Is Nothing Then
			excel.Quit()
		End If

		DiagramManager.EnableScreenUpdateEx(TrueTrue)

End Sub

Private Function ImportAttachments(ByRef ex As VariantByRef dict As Dictionary) As Integer

	Dim sheet As Object
	Dim range As Object

	Dim lNbAttachments&

	Dim sValue$, iValue%, sDefault$
	Dim lNbAttachmentsManaged&

	Dim MyAttachmentType As AttachmentType
	Dim MyAttachment As Attachment

	Dim sLastAttachmentType$

	Dim sDescription$, dt As Date, splitted$()

	Set sheet = ex.worksheets(XL_TAB_ATTACHMENT)
	sheet.Activate
	Set range = sheet.usedrange
	range.Select
	sLastAttachmentType = ""

	ImportAttachments = 0

	lNbAttachments = range.Rows.Count
	Debug.Print "Number of attachments: " & (lNbAttachments - 1)
	lNbAttachmentsManaged = 0

	For lCurRow = 2 To lNbAttachments
		sValue = Trim(CStr(range.Cells(lCurRow, 1).Value))
		If (sValue <> "") And ToImportExport(sValue) Then
			If (sValue <> sLastAttachmentType) Then
				Set MyAttachmentType = dict.AttachmentTypes(sValue)
				' Check if AttachmentType exists
				If MyAttachmentType Is Nothing Then
					' Attachment type not found, we create it
					Set MyAttachmentType = dict.AttachmentTypes.Add(sValue, "Imported from file: " & EXCEL_FILE)
					' Filter types: ValidAttachmentBinding.ObjectType
					FilterTypes(MyAttachmentType, sValue)
				End If
				sLastAttachmentType = sValue
			End If

			sValue = Trim(CStr(range.Cells(lCurRow, 2).Value))
			If (sValue <> "") Then
				Set MyAttachment = MyAttachmentType.Attachments(sValue)
				' Check if Attachment exists
				If MyAttachment Is Nothing Then
					' Attachment not found, we create it
					Set MyAttachment = MyAttachmentType.Attachments.Add(sValue,  "Imported from file: " & EXCEL_FILE, "", TEXT_TYPE)
					Debug.Print "Attachment created: " & MyAttachmentType.Name & " \ " & MyAttachment.Name
				Else
					Debug.Print "Attachment found: " & MyAttachmentType.Name & " \ " & MyAttachment.Name
				End If

				lNbAttachmentsManaged += 1

				sDescription = Trim(CStr(range.Cells(lCurRow, 3).Value))

				If sDescription <> "" Then
				
					MyAttachment.Description = sDescription

				End If

				iValue = CInt(Trim(range.Cells(lCurRow, 4).Value))

				MyAttachment.Datatype = iValue

				sValue = Trim(CStr(range.Cells(lCurRow, 6).Value))

				If sValue <> "" Then
				
					splitted = Split(sValue, ",")

					For Each sValue In splitted

						MyAttachment.TextList.Add(sValue)

					Next sValue

				End If

				sDefault = Trim(CStr(range.Cells(lCurRow, 5).Value))

				If (sDefault <> "") Then
					
					' Convert/Format the value to a string
					Select Case iValue

					Case NUMERIC_TYPE
						
						sDefault = CStr(CInt(sDefault))

					Case DATE_TYPE
						
						dt = CStr(CDate(sDefault))
						sDefault = Format(dt, "MM/DD/YYYY")

					Case TIME_TYPE
						
						dt = CStr(CDate(sDefault)) ' Type checking through casting
						sDefault = Format(dt, "hh:nn:ssAMPM") ' Expected ER/Studio format

					Case BOOLEAN_TYPE
						
						sDefault = CStr(CBool(sDefault))

					End Select

					MyAttachment.ValueDefault = sDefault

				End If

			End If

		End If
	Next lCurRow

	ImportAttachments = lNbAttachmentsManaged
End Function

Private Function ImportSecurities(ByRef ex As VariantByRef dict As Dictionary) As Integer

	Dim sheet As Object
	Dim range As Object

	Dim lNbSecurityProperties&

	Dim sValue$, iValue%, sDefault$
	Dim lNbSecuritiesManaged&

	Dim MySecurityType As SecurityType
	Dim MySecurityProperty As SecurityProperty

	Dim sLastSecurityType$

	Dim sDescription$, dt As Date, splitted$()

	Set sheet = ex.worksheets(XL_TAB_SECURITY)
	sheet.Activate
	Set range = sheet.usedrange
	range.Select
	sLastSecurityType = ""

	ImportSecurities = 0

	lNbSecurityProperties = range.Rows.Count
	Debug.Print "Number of data security information: " & (lNbSecurityProperties - 1)
	lNbSecuritiesManaged = 0

	For lCurRow = 2 To lNbSecurityProperties
		sValue = Trim(CStr(range.Cells(lCurRow, 1).Value))
		If (sValue <> "") And ToImportExport(sValue) Then
			If (sValue <> sLastSecurityType) Then
				Set MySecurityType = dict.SecurityTypes(sValue)
				' Check if Security Type exists
				If MySecurityType Is Nothing Then
					' Security type not found, we create it
					Set MySecurityType = dict.SecurityTypes.Add(sValue, "Imported from file: " & EXCEL_FILE)
				End If
				sLastSecurityType = sValue
			End If

			sValue = Trim(CStr(range.Cells(lCurRow, 2).Value))
			If (sValue <> "") Then
				Set MySecurityProperty = MySecurityType.SecurityProperties(sValue)
				' Check if Security Property exists
				If MySecurityProperty Is Nothing Then
					' Security Property not found, we create it
					Set MySecurityProperty = MySecurityType.SecurityProperties.Add(sValue,  "Imported from file: " & EXCEL_FILE, "", TEXT_TYPE)
					Debug.Print "Security Property created: " & MySecurityType.Name & " \ " & MySecurityProperty.Name
				Else
					Debug.Print "Security Property found: " & MySecurityType.Name & " \ " & MySecurityProperty.Name
				End If

				lNbSecuritiesManaged += 1

				sDescription = Trim(CStr(range.Cells(lCurRow, 3).Value))

				If sDescription <> "" Then
				
					MySecurityProperty.Description = sDescription

				End If

				iValue = CInt(Trim(range.Cells(lCurRow, 4).Value))

				MySecurityProperty.Datatype = iValue

				sValue = Trim(CStr(range.Cells(lCurRow, 6).Value))

				If sValue <> "" Then
				
					splitted = Split(sValue, ",")

					For Each sValue In splitted

						MySecurityProperty.TextList.Add(sValue)

					Next sValue

				End If

				sDefault = Trim(CStr(range.Cells(lCurRow, 5).Value))

				If (sDefault <> "") Then
					
					' Convert/Format the value to a string
					Select Case iValue

					Case NUMERIC_TYPE
						
						sDefault = CStr(CInt(sDefault))

					Case DATE_TYPE
						
						dt = CStr(CDate(sDefault))
						sDefault = Format(dt, "MM/DD/YYYY")

					Case TIME_TYPE
						
						dt = CStr(CDate(sDefault)) ' Type checking through casting
						sDefault = Format(dt, "hh:nn:ssAMPM") ' Expected ER/Studio format

					Case BOOLEAN_TYPE
						
						sDefault = CStr(CBool(sDefault))

					End Select

					MySecurityProperty.ValueDefault = sDefault

				End If

			End If

		End If
	Next lCurRow

	ImportSecurities = lNbSecuritiesManaged
End Function

ERSBasicHandlers.bas

Some different examples using the Attachments created and utilized by the previous macros.

⚠️ You need to update the path to the macro in the following script (Line 20):

''MACRO TITLE: ERSBasicHandlers
' MACRO VERSION: 3.0
'This macro binds specific Attachments and Data Security Information
'	for Entities, Tables, Attributes, Columns, Relationships, Views,
'	Models & Submodels to specific ER Objects if the Enterprise
'	Data Dictionary is available
'
' Dependencies
'	wBindPropertiesToERObjects.bas
'
' Known limitations
'	There's no event for Business Data Objects
'
' Release notes
' 3.0:	Data Security Information added
' 2.0:	Relationships & Views added
'		Attachments supported across multiple ER Objects
' 1.0:	Initial version
'---------------------------------------------------------------------------
'#Uses "C:\ProgramData\Idera\ERStudioDA_20.1\Macros\w\Bound attachments V3\wBindPropertiesToERObjects.bas"

Sub CreateEntityHandler(CurEntity As Object, CurDiagram As Object)

	BindProperties(True)	'	Lazy method: the function is looping over all supported objects = not optimized

End Sub

' Bind Attributes & Columns
Sub CreateAttributeHandler(CurAttribute As Object, CurDiagram As Object)
	
	Dim MyDiagram As Diagram
	Dim MyDictionary As Dictionary
	Dim MyModel As Model
	Dim MyAttachmentType As AttachmentType
	Dim MyAttachment As Attachment
	Dim MySecurityType As SecurityType
	Dim MySecurityProperty As SecurityProperty
	Dim MyAttribute As AttributeObj

	If CommonInit(CurDiagram, MyDiagram, MyDictionary) Then
		
		Set MyAttribute = CurAttribute
	
		Set MyModel = MyDiagram.ActiveModel
	
		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			
			If IsMatching(MyAttachmentType.NameIIf(MyModel.Logical, ATTRIBUTES, COLUMNS)) Then
				
				For Each MyAttachment In MyAttachmentType.Attachments
	
					MyAttribute.BoundAttachments.Add(MyAttachment.ID)
	
				Next
	
			End If
	
		Next MyAttachmentType
	
		For Each MySecurityType In MyDictionary.SecurityTypes
			
			If IsMatching(MySecurityType.NameIIf(MyModel.Logical, ATTRIBUTES, COLUMNS)) Then
				
				For Each MySecurityProperty In MySecurityType.SecurityProperties
	
					MyAttribute.BoundSecurityProperties.Add(MySecurityProperty.ID)
	
				Next
	
			End If
	
		Next MySecurityType

	End If

End Sub


Sub CreateRelationshipHandler(CurRelationship As Object, CurDiagram As Object)
	
	' Relationships don't have Data Security Information

	Dim MyDiagram As Diagram
	Dim MyDictionary As Dictionary
	Dim MyAttachmentType As AttachmentType
	Dim MyAttachment As Attachment
	Dim MyRelationship As Relationship

	If CommonInit(CurDiagram, MyDiagram, MyDictionary) Then
		
		Set MyRelationship = CurRelationship

		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			
			If IsMatching(MyAttachmentType.Name, RELATIONSHIPS) Then
				
				For Each MyAttachment In MyAttachmentType.Attachments
	
					MyRelationship.BoundAttachments.Add(MyAttachment.ID)
	
				Next
	
			End If
	
		Next

	End If

End Sub


Sub CreateIndexHandler(CurIndex As Object, CurDiagram As Object)

End Sub


Sub CreateModelHandler(CurModel As Object, CurDiagram As Object)
	
	Dim MyDiagram As Diagram
	Dim MyDictionary As Dictionary
	Dim MyModel As Model
	Dim MyAttachmentType As AttachmentType
	Dim MyAttachment As Attachment
	Dim MySecurityType As SecurityType
	Dim MySecurityProperty As SecurityProperty

	If CommonInit(CurDiagram, MyDiagram, MyDictionary) Then
		
		Set MyModel = CurModel

		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			
			If IsMatching(MyAttachmentType.Name, MODELS) Then
				
				For Each MyAttachment In MyAttachmentType.Attachments
	
					MyModel.BoundAttachments.Add(MyAttachment.ID)
	
				Next
	
			End If
	
		Next

		For Each MySecurityType In MyDictionary.SecurityTypes
			
			If IsMatching(MySecurityType.Name, MODELS) Then
				
				For Each MySecurityProperty In MySecurityType.SecurityProperties
	
					MyModel.BoundSecurityProperties.Add(MySecurityProperty.ID)
	
				Next
	
			End If
	
		Next

	End If

End Sub


Sub CreateSubModelHandler(CurSubModel As Object, CurDiagram As Object)
	
	Dim MyDiagram As Diagram
	Dim MyDictionary As Dictionary
	Dim MySubmodel As SubModel
	Dim MyAttachmentType As AttachmentType
	Dim MyAttachment As Attachment
	Dim MySecurityType As SecurityType
	Dim MySecurityProperty As SecurityProperty

	If CommonInit(CurDiagram, MyDiagram, MyDictionary) Then
		
		Set MySubmodel = CurSubModel

		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			
			If IsMatching(MyAttachmentType.Name, SUBMODELS) Then
				
				For Each MyAttachment In MyAttachmentType.Attachments
	
					MySubmodel.BoundAttachments.Add(MyAttachment.ID)
	
				Next
	
			End If
	
		Next
	
		For Each MySecurityType In MyDictionary.SecurityTypes
			
			If IsMatching(MySecurityType.Name, SUBMODELS) Then
				
				For Each MySecurityProperty In MySecurityType.SecurityProperties
	
					MySubmodel.BoundSecurityProperties.Add(MySecurityProperty.ID)
	
				Next
	
			End If
	
		Next

	End If

End Sub


Sub CreateDomainHandler(CurDomain As Object, CurDiagram As Object)

End Sub


Sub CreateDefaultHandler(CurDefault As Object, CurDiagram As Object)

End Sub


Sub CreateUserDatatypeHandler(CurUserDatatype As Object, CurDiagram As Object)

End Sub


Sub CreateRuleHandler(CurRule As Object, CurDiagram As Object)

End Sub


Sub CreateViewHandler(CurView As Object, CurDiagram As Object)
	
	Dim MyDiagram As Diagram
	Dim MyDictionary As Dictionary
	Dim MyAttachmentType As AttachmentType
	Dim MyAttachment As Attachment
	Dim MySecurityType As SecurityType
	Dim MySecurityProperty As SecurityProperty
	Dim MyView As View

	If CommonInit(CurDiagram, MyDiagram, MyDictionary) Then
		
		Set MyView = CurView

		For Each MyAttachmentType In MyDictionary.AttachmentTypes
			
			If IsMatching(MyAttachmentType.Name, VIEWS) Then
				
				For Each MyAttachment In MyAttachmentType.Attachments
	
					MyView.BoundAttachments.Add(MyAttachment.ID)
	
				Next
	
			End If
	
		Next
	
		For Each MySecurityType In MyDictionary.SecurityTypes
			
			If IsMatching(MySecurityType.Name, VIEWS) Then
				
				For Each MySecurityProperty In MySecurityType.SecurityProperties
	
					MyView.BoundSecurityProperties.Add(MySecurityProperty.ID)
	
				Next
	
			End If
	
		Next

	End If

End Sub


Sub CreateTriggerHandler(CurTrigger As Object, CurDiagram As Object)

End Sub


Sub CreateProcedureHandler(CurProcedure As Object, CurDiagram As Object)

End Sub


Sub CreateViewRelationshipHandler(CurViewRelationship As Object, CurDiagram As Object)

End Sub

Sub CreateDiagramHandler(CurDiagram As Object)
	
	' We don't load the attachments as they are already existing in the Enterprise Data Dictionary
'	' Load Attachments
'	MacroRun "C:\ProgramData\Idera\ERStudioDA_20.1\Macros\w\Bound attachments V3\wReadPropertiesFromExcel.bas"

End Sub

Sub CreateEntityDisplayHandler(CurEntityDisplay As Object, CurDiagram As Object)

End Sub

Sub CreateRelationshipDisplayHandler(CurRelationshipDisplay As Object, CurDiagram As Object)

End Sub

Sub CreateViewDisplayHandler(CurViewDisplay As Object, CurDiagram As Object)

End Sub

Sub CreateViewRelationshipDisplayHandler(CurViewRelationshipDisplay As Object, CurDiagram As Object)

End Sub

Sub CreateViewFieldHandler(CurViewField As Object, CurDiagram As Object)

End Sub

Sub CreateFKColumnPairHandler(CurFKColumnPair As Object, CurDiagram As Object)

End Sub

Sub CreateIndexColumnHandler(CurIndexColumn As Object, CurDiagram As Object)

End Sub

Sub CreateSubTypeHandler(CurSubType As Object, CurDiagram As Object)

End Sub

Sub CreateSubTypeClusterHandler(CurSubTypeCluster As Object, CurDiagram As Object)

End Sub

Private Function CommonInit(ByRef CurDiagram As ObjectByRef MyDiagram As Diagram, ByRef MyDictionary As Dictionary) As Boolean
	
	Set MyDiagram = CurDiagram

	If DICTIONARY_NAME = "" Then
		Set MyDictionary = MyDiagram.Dictionary
	Else
		Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(DICTIONARY_NAME)
	End If

	CommonInit = Not (MyDiagram Is Nothing Or MyDictionary Is Nothing)

End Function

Summary

It now supports EntitiesTablesAttributesColumnsRelationships, Views, Models, Submodels & Business Data Objects, but it can be easily extended to also support other objects (Shapes, etc.).

In the two previous posts, we used a Local Data Dictionary.

In the above scripts, we have utilized an Enterprise Data Dictionary containing all our Attachments and Data Security Information.
This Enterprise Data Dictionary is bound to all projects to ensure consistency in properties across all diagrams.

Enterprise Data Dictionaries
Enterprise Data Dictionaries bound to the project

Then, if we publish our project in Team Server Core, everyone can directly access the models and the values of the Attachments & Data Security Information.

Model shared with Team Server Core
Model shared with Team Server Core
Team Server Core
Properties available through Team Server Core

Moreover, from the Attachments and Data Security Information properties, we can see where they are bound and the values used by each object:

Attachment bindings through Team Server Core
Attachment bindings through Team Server Core
Data Security Information bindings through Team Server Core
Data Security Information bindings through Team Server Core

Finally, this post should conclude this trilogy where we have seen the 5 scripts evolve through successive updates.

As usual, feel free to modify the scripts to meet your expectations perfectly, or simply copy parts of these scripts into your own macros.

Aligning complex data environments with business goals for over 30 years.
Copyright © 2024 Idera, Inc.