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
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
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 (the following four scripts all use this one)
- wGeneratePropertiesToExcel.bas
- wReadPropertiesFromExcelWithUI.bas
- wReadPropertiesFromExcel.bas
- ERSBasicHandlers.bas
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(False, False) Debug.Clear BindProperties(False) ErrorEnd: DiagramManager.EnableScreenUpdateEx(True, True) 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 Nothing) Then 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.Name, IIf(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.Name, IIf(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.Name, IIf(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.Name, IIf(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.Name) Then 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.Name) Then 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 String) As 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 Object, ByRef wb As Object, ByRef 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(False, False) lNbAttachmentsManaged = ImportAttachments(excel, MyDictionary) lNbSecurityPropertiesManaged = ImportSecurities(excel, MyDictionary) If ((lNbAttachmentsManaged > 0) Or (lNbSecurityPropertiesManaged > 0)) And dlg.cbBind Then BindProperties(False) End If DiagramManager.EnableScreenUpdateEx(True, True) 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(True, True) 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 Variant, ByRef 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 Variant, ByRef 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(False, False) 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(True, True) 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(True, True) End Sub Private Function ImportAttachments(ByRef ex As Variant, ByRef 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 Variant, ByRef 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.Name, IIf(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.Name, IIf(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 Object, ByRef 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 Entities, Tables, Attributes, Columns, Relationships, 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 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
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
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.