Introduction
In this previous post, I shared a file named ERSBasicHandlers.bas which featured functionality for speaking different texts depending on the event.
In this post, I’ll be sharing several macros, including an example of another version of the ERSBasicHandlers.bas file.
Sometimes, you may need to specify custom properties for various objects such as Entities, Tables, Attributes, etc. The macros I’ll be sharing in this post, allow us to:
- Export the attachments from the current project (if existing attachments are present, we can generate the desired Excel workbook for reference)
- Import attachments from an Excel Workbook
- Bind the attachments to specific objects (Entities, etc.).
You can see the different macros in action in this video:
There are four different macros and the ERSBasicHandlers.bas file:
- The first macro enables us to export Attachment Types & Attachments from the active diagram:
wGenerate Attachments to Excel.bas
⚠️It doesn’t export the bound values!
wGenerate Attachments to Excel
- The next two macros are for importing Attachment Types & Attachments into the current diagram:
wRead Attachments from Excel with UI.bas: this version includes a user interface prompting for the Excel file.
wRead Attachments from Excel with UI
wReadAttachmentsFromExcel.bas: this version uses constants for the options, making it callable from a batch or another macro.
- the fourth macro binds different attachments to various ER objects:
wBindAttachmentsToERObjects.bas - Additionally, the last macro utilizes two of the previous macros and binds attachments to their respective objects upon creation:
ERSBasicHandlers.bas
Scripts
wGenerate Attachments to Excel.bas
'#Language "WWB-COM" ''MACRO TITLE: wGenerate Attachments to Excel ' MACRO VERSION: 1.1 'This macro exports specific Attachments for Entities|Tables|Attributes|Columns ' ' Dependencies: ' Excel ' ' Release notes ' 1.1: Refactoring and removal of dead code ' 1.0: Initial version '--------------------------------------------------------------------------- Option Explicit Const TITLE$ = "wGenerate Attachments to Excel" Const TIMESTAMPED As Boolean = True ' Datatypes Constants Const BOOLEAN_TYPE% = 1 Const DATE_TYPE% = 2 Const EXTERNAL_FILE_PATH_TYPE% = 3 Const NUMERIC_TYPE% = 4 Const TEXT_TYPE% = 5 Const TEXT_LIST_TYPE% = 6 Const TIME_TYPE% = 7 ' Excel constants Const xlCenter% = -4108 Const xlBottom% = -4107 Const xlTop% = -4160 Const xlLeft% = -4131 Const xlRight% = -4152 Const xlCalculationAutomatic& = -4105 Const xlCalculationManual& = -4135 Const xlCalculationSemiautomatic& = 2 Sub Main Dim MyDiagram As Diagram Dim MyDictionary As Dictionary Dim dictionary_list$() Dim MyAttachmentType As AttachmentType Dim MyAttachment As Attachment ' Excel variables Dim excel As Object Dim wb As Object Dim sheet 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 ' Skip the header If init_dictionary_list(MyDiagram, MyDictionary, 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 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 LogIt MyAttachmentType.Name & "\" & MyAttachment.Name curRow += 1 Next MyAttachment Next MyAttachmentType Comments_AutoSize(sheet) 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) 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 Set sheet = wb.activesheet 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 End Sub Private Sub AutofitAllUsed(ByRef 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 MyDictionary As Dictionary, ByRef dictionary_list$()) As Boolean Dim i% 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 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
wRead Attachments from Excel with UI.bas
'#Language "WWB-COM" ''MACRO TITLE: wRead Attachments from Excel with UI ' MACRO VERSION: 1.1 'This macro imports specific Attachments for Entities|Tables|Attributes|Columns ' ' Dependencies: ' wBindAttachmentstoERObjects.bas ' Excel ' ' Release notes ' 1.1: Refactoring and removal of dead code ' 1.0: Initial version '--------------------------------------------------------------------------- '#Uses "wBindAttachmentstoERObjects.BAS" Option Explicit Private Const TITLE$ = "wRead Attachments from Excel" ' Datatypes Constants Const BOOLEAN_TYPE% = 1 Const DATE_TYPE% = 2 Const EXTERNAL_FILE_PATH_TYPE% = 3 Const NUMERIC_TYPE% = 4 Const TEXT_TYPE% = 5 Const TEXT_LIST_TYPE% = 6 Const TIME_TYPE% = 7 ' Excel constants Const xlCenter% = -4108 Const xlBottom% = -4107 Const xlTop% = -4160 Const xlLeft% = -4131 Const xlRight% = -4152 Dim XLfile$ Dim lCurRow% Sub Main Dim excel As Object Dim MyDiagram As Diagram Dim MyDictionary As Dictionary Dim lNbManaged& 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) lNbManaged = ImportAttachments(excel, MyDictionary) If (lNbManaged > 0) And dlg.cbBind Then BindAttachments(False) End If DiagramManager.EnableScreenUpdateEx(True, True) excel.Quit() MsgBox ("ERObjects Attachments imported" & vbCrLf & vbCrLf & lNbManaged & " attachment" & If(lNbManaged > 1, "s", "") & " managed", vbInformation, TITLE) Debug.Print Debug.Print lNbManaged & " attachment" & If(lNbManaged > 1, "s", "") & " 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) As Integer 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(1) 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 <> "") 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) 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, 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" ws.Cells(5, 2).Value = "Attachment 1" ws.Cells(5, 3).Value = "My Attribute property description" ws.Cells(5, 4).Value = TEXT_TYPE ws.Cells(6, 1).Value = "Columns" ws.Cells(6, 2).Value = "Attachment 1" ws.Cells(6, 3).Value = "My 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) Comments_AutoSize(ws) 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,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 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
wReadAttachmentsFromExcel.bas
⚠️ You need to update the path to the Excel workbook (Line 21).
'#Language "WWB-COM" ''MACRO TITLE: wRead Attachments from Excel ' MACRO VERSION: 1.1 'This macro imports specific Attachments for Entities|Tables|Attributes|Columns ' ' Dependencies: ' wBindAttachmentstoERObjects.bas ' Excel ' ' Release notes ' 1.1: Refactoring and removal of dead code ' 1.0: Initial version '--------------------------------------------------------------------------- '#Uses "wBindAttachmentstoERObjects.BAS" Option Explicit Private Const TITLE$ = "wRead Attachments from Excel" Private Const DICTIONARY_NAME$ = "" ' Empty = Local Data Dictionary; Name of the Enterprise Data Dictionary Private Const EXCEL_FILE$ = "C:\Users\William\Documents\ERStudio Data Architect 20.1\Tests\default_attachments.xlsx" ' Path to the workbook with the attachments list Private Const BIND_ATTACHMENTS_TO_EROBJECTS = True ' Datatypes Constants Private Const BOOLEAN_TYPE% = 1 Private Const DATE_TYPE% = 2 Private Const EXTERNAL_FILE_PATH_TYPE% = 3 Private Const NUMERIC_TYPE% = 4 Private Const TEXT_TYPE% = 5 Private Const TEXT_LIST_TYPE% = 6 Private Const TIME_TYPE% = 7 ' Excel constants Private Const xlCenter% = -4108 Private Const xlBottom% = -4107 Private Const xlTop% = -4160 Private Const xlLeft% = -4131 Private Const xlRight% = -4152 Dim lCurRow% Sub Main Dim excel As Object Dim lNbManaged& Dim MyDiagram As Diagram Dim MyDictionary As Dictionary Dim MyModel As Model Debug.Clear Set MyDiagram = DiagramManager.ActiveDiagram If Not MyDiagram Is Nothing Then Set MyModel = MyDiagram.ActiveModel 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) lNbManaged = ImportAttachments(excel, MyDictionary) If (lNbManaged > 0) And BIND_ATTACHMENTS_TO_EROBJECTS Then BindAttachments(False) End If DiagramManager.EnableScreenUpdateEx(True, True) excel.Quit() MsgBox ("ERObjects Attachments imported" & vbCrLf & vbCrLf & lNbManaged & " attachment" & If(lNbManaged > 1, "s", "") & " managed", vbInformation, TITLE) Debug.Print Debug.Print lNbManaged & " attachment" & If(lNbManaged > 1, "s", "") & " 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 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(1) 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 <> "") 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) 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
wBindAttachmentstoERObjects.bas
'#Language "WWB-COM" ''MACRO TITLE: wBind Attachments to ER Objects ' MACRO VERSION: 1.1 'This macro binds the Attachments for Entities|Tables|Attributes|Columns ' ' Release notes ' 1.1: Refactoring and removal of dead code ' 1.0: Initial version '--------------------------------------------------------------------------- Option Explicit Public Const ENTITIES$ = "Entities" Public Const TABLES$ = "Tables" Public Const ATTRIBUTES$ = "Attributes" Public Const COLUMNS$ = "Columns" Sub main On Error GoTo ErrorEnd DiagramManager.EnableScreenUpdateEx(False, False) Debug.Clear BindAttachments(False) ErrorEnd: DiagramManager.EnableScreenUpdateEx(True, True) End Sub Public Sub BindAttachments(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 Set MyDictionary = MyDiagram.Dictionary ' Update this line to use an Enterprise Data Dictionary ' Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item("My Enterprise DD") If Not MyDictionary Is Nothing Then Debug.Print If currentModelOnly Then Set MyModel = MyDiagram.ActiveModel Debug.Print "Model: " & vbTab & MyModel.Name BindModelAttachment(MyDictionary, MyModel) Else For Each MyModel In MyDiagram.Models Debug.Print "Model: " & vbTab & MyModel.Name BindModelAttachment(MyDictionary, MyModel) Next End If End If End If End Sub Private Sub BindModelAttachment(MyDictionary As Dictionary, MyModel As Model) Dim MyEntity As Entity Dim MyAttribute As AttributeObj Dim MyAttachmentTypeParent As AttachmentType, MyAttachmentTypeChild As AttachmentType Dim MyAttachment As Attachment Set MyAttachmentTypeParent = MyDictionary.AttachmentTypes(IIf(MyModel.Logical, ENTITIES, TABLES)) Set MyAttachmentTypeChild = MyDictionary.AttachmentTypes(IIf(MyModel.Logical, ATTRIBUTES, COLUMNS)) If (Not MyAttachmentTypeParent Is Nothing) Or (Not MyAttachmentTypeChild Is Nothing) Then ' Attachment Type for Entities or Attributes exists ' Bind Entities' Attachments For Each MyEntity In MyModel.Entities If (Not MyAttachmentTypeParent Is Nothing) Then For Each MyAttachment In MyAttachmentTypeParent.Attachments MyEntity.BoundAttachments.Add(MyAttachment.ID) Next Debug.Print IIf(MyModel.Logical, "Entity:" & vbTab & MyEntity.EntityName, "Table:" & vbTab & MyEntity.TableName) End If ' Bind Attributes' Attachments If (Not MyAttachmentTypeChild Is Nothing) Then For Each MyAttribute In MyEntity.Attributes For Each MyAttachment In MyAttachmentTypeChild.Attachments MyAttribute.BoundAttachments.Add(MyAttachment.ID) Next Debug.Print IIf(MyModel.Logical, "Attribute:" & vbTab & MyAttribute.AttributeName, "Column:" & vbTab & MyAttribute.ColumnName) Next End If Next End If Debug.Print End Sub
ERSBasicHandlers.bas
Some different examples using the attachments created and utilized by the previous macros.
⚠️ You need to update the paths to the macros in the following script (Lines 13 & 116):
''MACRO TITLE: ERSBasicHandlers ' MACRO VERSION: 1.0 'This macro imports specific Attachments for Entities|Tables|Attributes|Columns ' and binds them to specific ER Objects ' ' Dependencies: ' wBindAttachmentstoERObjects.bas ' Excel ' ' Release notes ' 1.0: Initial version '--------------------------------------------------------------------------- '#Uses "C:\ProgramData\Idera\ERStudioDA_20.1\Macros\w\Bound attachments\wBindAttachmentstoERObjects.bas" Sub CreateEntityHandler(CurEntity As Object, CurDiagram As Object) BindAttachments(True) End Sub 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 MyAttribute As AttributeObj Set MyDiagram = CurDiagram Set MyDictionary = MyDiagram.Dictionary ' Update this line to use an Enterprise Data Dictionary Set MyModel = MyDiagram.ActiveModel Set MyAttachmentType = MyDictionary.AttachmentTypes(IIf(MyModel.Logical, ATTRIBUTES, COLUMNS)) If Not MyAttachmentType Is Nothing Then Set MyAttribute = CurAttribute For Each MyAttachment In MyAttachmentType.Attachments MyAttribute.BoundAttachments.Add(MyAttachment.ID) Next End If End Sub Sub CreateRelationshipHandler(CurRelationship As Object, CurDiagram As Object) End Sub Sub CreateIndexHandler(CurIndex As Object, CurDiagram As Object) End Sub Sub CreateModelHandler(CurModel As Object, CurDiagram As Object) End Sub Sub CreateSubModelHandler(CurSubModel As Object, CurDiagram As Object) 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) 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) ' Load Attachments MacroRun "C:\ProgramData\Idera\ERStudioDA_20.1\Macros\w\Bound attachments\wReadAttachmentsFromExcel.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
Summary
It currently supports Entities, Tables, Attributes & Columns, but it can be easily extended to also support other objects (Relationships, etc.).
So, as usual, feel free to modify the scripts so that they perfectly meet your expectations, or simply copy parts of these scripts into your own macros.
Moreover, I strongly suggest using an Enterprise Data Dictionary to store your attachments, allowing you to directly share them through the Repository.
Bonus
A short video which shows how to create a macro from a script in ER/Studio Data Architect: