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,...
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:
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.
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
'---------------------------------------------------------------------------
OptionExplicit
Const TITLE$ = "wGenerate Attachments to Excel"Const TIMESTAMPED AsBoolean = True
' Datatypes ConstantsConst 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 constantsConst 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 variablesDim excel AsObjectDim wb AsObjectDim sheet AsObject
Dim MyListMember As ListMember
Dim sList$
Dim curRow%
Debug.Clear
'Get the current diagram.Set MyDiagram = DiagramManager.ActiveDiagram
IfNot MyDiagram IsNothingThen' ExcelSet 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 headerIf init_dictionary_list(MyDiagram, MyDictionary, dictionary_list) ThenSet MyDictionary = MyDiagram.Dictionary
ElseBegin 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 ThenIf dictionary_list(dlg.dictionary_select) = "Local"ThenSet MyDictionary = MyDiagram.Dictionary
ElseSet MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(dictionary_list(dlg.dictionary_select))
EndIfElseExitSubEndIfEndIfIfNot MyDictionary IsNothingThen
LogIt "Dictionary: " & MyDictionary.Name' Get all attachmentsForEach MyAttachmentType In MyDictionary.AttachmentTypes
ForEach 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
SelectCase MyAttachment.Datatype
Case TEXT_LIST_TYPE
sList = ""ForEach MyListMember In MyAttachment.TextList
sList += MyListMember.Text & ","Next MyListMember
IfRight(sList, 1) = ","Then
sList = Left(sList, Len(sList) - 1)
EndIf
sheet.Cells(curRow, 6).Value = sList
EndSelect
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.AutoFitMsgBox"Export completed !", vbInformation, TITLE
EndIf
ElseMsgBox"No project opened!", vbExclamation, TITLE
EndIfEndSub
PrivateFunction PrefixDT(txt AsString) AsStringIf TIMESTAMPED Then
PrefixDT = CStr(Now) & Chr(9) & txt
Else
PrefixDT = txt
EndIf
EndFunction
PrivateSub LogIt(ByVal txt AsString)
Debug.Print PrefixDT(txt)
EndSub
PrivateSub PrintHeader(ByRef excel AsObject, ByRef wb AsObject, ByRef sheet AsObject)
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
EndWith
With excel
With .ActiveWindow
.SplitColumn = 1
.SplitRow = 1
EndWith
.ActiveWindow.FreezePanes = TrueEndWith
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"EndWith
With sheet.range("A:A")
.interior.colorindex = 15
.verticalalignment = xlBottom
.horizontalalignment = xlLeft
.font.Bold = True
.font.Size = 9
EndWith
EndSub
PrivateSub AutofitAllUsed(ByRef excel AsObject)
Dim x AsLong
For x = 1 To excel.ActiveSheet.UsedRange.Columns.Count
excel.ActiveSheet.UsedRange.Columns(x).EntireColumn.AutoFit
Next x
EndSub
' Initialize the dictionary drop down listFunction init_dictionary_list(ByRef MyDiagram As Diagram, ByRef MyDictionary As Dictionary, ByRef dictionary_list$()) AsBooleanDim i%
ReDim dictionary_list$(0 To MyDiagram.EnterpriseDataDictionaries.Count)
dictionary_list (0) = "Local"
i = 1
ForEach MyDictionary In MyDiagram.EnterpriseDataDictionaries
dictionary_list (i) = MyDictionary.Name
i = i + 1
Next
init_dictionary_list = MyDiagram.EnterpriseDataDictionaries.Count = 0
EndFunction
Sub Comments_AutoSize(s AsObject)
' https://www.contextures.com/xlcomments03.htmlDim MyComments AsObjectDim lArea AsLongDim lMult AsDoubleDim MaxW AsLongDim NewW AsLong'Height adjustment factor'of 1.1 seems to work ok.
lMult = 1.1
MaxW = 300
NewW = 200
ForEach MyComments In s.Comments
With MyComments
.Shape.TextFrame.AutoSize = TrueIf .Shape.Width > MaxW Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = NewW
.Shape.Height = (lArea / NewW) * lMult
EndIfEndWithNext' commentEndSub
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"
OptionExplicit
PrivateConst TITLE$ = "wRead Attachments from Excel"
' Datatypes ConstantsConst 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 constantsConst xlCenter% = -4108
Const xlBottom% = -4107
Const xlTop% = -4160
Const xlLeft% = -4131
Const xlRight% = -4152
Dim XLfile$
Dim lCurRow%
Sub Main
Dim excel AsObjectDim MyDiagram As Diagram
Dim MyDictionary As Dictionary
Dim lNbManaged&
Dim dictionary_list$()
Debug.Clear
Set MyDiagram = DiagramManager.ActiveDiagram
IfNot MyDiagram IsNothingThenBegin 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 dialogIf Dialog(dlg) = -1 ThenIf dictionary_list(dlg.dictionary_select) = "Local"ThenSet MyDictionary = MyDiagram.Dictionary
ElseSet MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(dictionary_list(dlg.dictionary_select))
EndIf'initialize excel object and make visibleSet excel = CreateObject("Excel.Application")
'this Error Is For an errant file path, Dialog will be restartedOnErrorGoTo Error_open
XLfile = dlg.Path
excel.workbooks.Open XLfile
OnErrorGoTo Error_unknown
DiagramManager.EnableScreenUpdateEx(False, False)
lNbManaged = ImportAttachments(excel, MyDictionary)
If (lNbManaged > 0) And dlg.cbBind Then
BindAttachments(False)
EndIf
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"ExitSub
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)
IfNot excel IsNothingThen
excel.Quit()
EndIf
DiagramManager.EnableScreenUpdateEx(True, True)
EndIf
ElseMsgBox"No project opened!", vbExclamation, TITLE
EndIf
EndSub
'initialize the dictionary drop down listSub 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
ForEach MyDictionary In MyDiagram.EnterpriseDataDictionaries
dictionary_list (i) = MyDictionary.Name
i = i + 1
Next
EndSub
PrivateFunction ImportAttachments(ByRef ex AsVariant, ByRef MyDictionary As Dictionary) AsInteger
Dim sheet AsObjectDim range AsObject
Dim sValue$, iValue%, sDefault$
Dim lNbAttachments&, lNbAttachmentsManaged&
Dim MyAttachmentType As AttachmentType
Dim MyAttachment As Attachment
Dim sLastAttachmentType$
Dim sDescription$, dt AsDate, 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 <> "") ThenIf (sValue <> sLastAttachmentType) ThenSet MyAttachmentType = MyDictionary.AttachmentTypes(sValue)
' Check if AttachmentType existsIf MyAttachmentType IsNothingThen' Attachment type not found, we create itSet MyAttachmentType = MyDictionary.AttachmentTypes.Add(sValue, "Imported from file: " & XLfile)
EndIf
sLastAttachmentType = sValue
EndIf
sValue = Trim(CStr(range.Cells(lCurRow, 2).Value))
If (sValue <> "") ThenSet MyAttachment = MyAttachmentType.Attachments(sValue)
' Check if Attachment existsIf MyAttachment IsNothingThen' Attachment not found, we create itSet MyAttachment = MyAttachmentType.Attachments.Add(sValue, "Imported from file: " & XLfile, "", TEXT_TYPE)
Debug.Print"Attachment created: " & MyAttachmentType.Name & " \ " & MyAttachment.NameElse
Debug.Print"Attachment found: " & MyAttachmentType.Name & " \ " & MyAttachment.NameEndIf
lNbAttachmentsManaged += 1
sDescription = Trim(CStr(range.Cells(lCurRow, 3).Value))
If sDescription <> ""Then
MyAttachment.Description = sDescription
EndIf
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, ",")
ForEach sValue In splitted
MyAttachment.TextList.Add(sValue)
Next sValue
EndIf
sDefault = Trim(CStr(range.Cells(lCurRow, 5).Value))
If (sDefault <> "") Then' Convert/Format the value to a stringSelectCase 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))
EndSelect
MyAttachment.ValueDefault = sDefault
EndIf
EndIf
EndIfNext lCurRow
ImportAttachments = lNbAttachmentsManaged
EndFunction
Sub PrintSampleSheet()
Dim sample AsObjectDim wb, ws AsVariant
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
EndSub
PrivateFunction DialogFunc(DlgItem$, Action%, SuppValue&) AsBooleanSelectCase Action%
Case 1 ' Dialog box initialization
DlgValue("cbBind", True)
Case 2 ' Value changing or button pressedIf 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 = TrueElseIf DlgItem = "SampleSheet"Then
PrintSampleSheet
DialogFunc = TrueElseIf DlgItem = "OK"And DlgText("path") = ""Then'don't exit dialog if a path is not specifiedMsgBox("Please enter a valid path.", vbExclamation, TITLE)
DialogFunc = TrueEndIfRem DialogFunc = True ' Prevent button press from closing the dialog box
Case 3 ' TextBox or ComboBox text changedCase 4 ' Focus changedCase 5 ' IdleRem DialogFunc = True ' Continue getting idle actionsCase 6 ' Function keyEndSelect
EndFunction
PrivateSub AutofitAllUsed(excelObj)
Dim x AsLong
For x = 1 To excelObj.ActiveSheet.UsedRange.Columns.Count
excelObj.ActiveSheet.UsedRange.Columns(x).EntireColumn.AutoFit
Next x
EndSub
PrivateSub PrintHeader(excel AsObject,sheet AsVariant)
sheet.Name = "Attachments"
With sheet.range("A1:F1")
.interior.colorindex = 15
.font.Size = 9
.font.Bold = True
.horizontalalignment = xlCenter
EndWith
With excel
With .ActiveWindow
.SplitColumn = 1
.SplitRow = 1
EndWith
.ActiveWindow.FreezePanes = TrueEndWith
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"EndWith
With sheet.range("A:A")
.interior.colorindex = 15
.verticalalignment = xlBottom
.horizontalalignment = xlLeft
.font.Bold = True
.font.Size = 9
EndWith
EndSub
Sub Comments_AutoSize(s AsObject)
' https://www.contextures.com/xlcomments03.htmlDim MyComments AsObjectDim lArea AsLongDim lMult AsDoubleDim MaxW AsLongDim NewW AsLong'Height adjustment factor'of 1.1 seems to work ok.
lMult = 1.1
MaxW = 300
NewW = 200
ForEach MyComments In s.Comments
With MyComments
.Shape.TextFrame.AutoSize = TrueIf .Shape.Width > MaxW Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = NewW
.Shape.Height = (lArea / NewW) * lMult
EndIfEndWithNext' commentEndSub
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"
OptionExplicit
PrivateConst TITLE$ = "wRead Attachments from Excel"
PrivateConst DICTIONARY_NAME$ = ""' Empty = Local Data Dictionary; Name of the Enterprise Data DictionaryPrivateConst EXCEL_FILE$ = "C:\Users\William\Documents\ERStudio Data Architect 20.1\Tests\default_attachments.xlsx"' Path to the workbook with the attachments listPrivateConst BIND_ATTACHMENTS_TO_EROBJECTS = True
' Datatypes ConstantsPrivateConst BOOLEAN_TYPE% = 1
PrivateConst DATE_TYPE% = 2
PrivateConst EXTERNAL_FILE_PATH_TYPE% = 3
PrivateConst NUMERIC_TYPE% = 4
PrivateConst TEXT_TYPE% = 5
PrivateConst TEXT_LIST_TYPE% = 6
PrivateConst TIME_TYPE% = 7
' Excel constantsPrivateConst xlCenter% = -4108
PrivateConst xlBottom% = -4107
PrivateConst xlTop% = -4160
PrivateConst xlLeft% = -4131
PrivateConst xlRight% = -4152
Dim lCurRow%
Sub Main
Dim excel AsObjectDim lNbManaged&
Dim MyDiagram As Diagram
Dim MyDictionary As Dictionary
Dim MyModel As Model
Debug.Clear
Set MyDiagram = DiagramManager.ActiveDiagram
IfNot MyDiagram IsNothingThenSet MyModel = MyDiagram.ActiveModel
start_dialog:
If DICTIONARY_NAME = ""ThenSet MyDictionary = MyDiagram.Dictionary
ElseSet MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(DICTIONARY_NAME)
EndIfIfNot MyDictionary IsNothingThen'initialize excel object and make visibleSet excel = CreateObject("Excel.Application")
'this Error Is For an errant file path, Dialog will be restartedOnErrorGoTo Error_open
excel.workbooks.Open EXCEL_FILE
OnErrorGoTo Error_unknown
DiagramManager.EnableScreenUpdateEx(False, False)
lNbManaged = ImportAttachments(excel, MyDictionary)
If (lNbManaged > 0) And BIND_ATTACHMENTS_TO_EROBJECTS Then
BindAttachments(False)
EndIf
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"ElseMsgBox"Data dictionary not available!", vbExclamation, TITLE
EndIf
ElseMsgBox"No project opened!", vbExclamation, TITLE
EndIf
ExitSub
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)
IfNot excel IsNothingThen
excel.Quit()
EndIf
DiagramManager.EnableScreenUpdateEx(True, True)
EndSub
PrivateFunction ImportAttachments(ByRef ex AsVariant, ByRef dict As Dictionary) AsInteger
Dim sheet AsObjectDim range AsObject
Dim sValue$, iValue%, sDefault$
Dim lNbAttachments&, lNbAttachmentsManaged&
Dim MyAttachmentType As AttachmentType
Dim MyAttachment As Attachment
Dim sLastAttachmentType$
Dim sDescription$, dt AsDate, 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 <> "") ThenIf (sValue <> sLastAttachmentType) ThenSet MyAttachmentType = dict.AttachmentTypes(sValue)
' Check if AttachmentType existsIf MyAttachmentType IsNothingThen' Attachment type not found, we create itSet MyAttachmentType = dict.AttachmentTypes.Add(sValue, "Imported from file: " & EXCEL_FILE)
EndIf
sLastAttachmentType = sValue
EndIf
sValue = Trim(CStr(range.Cells(lCurRow, 2).Value))
If (sValue <> "") ThenSet MyAttachment = MyAttachmentType.Attachments(sValue)
' Check if Attachment existsIf MyAttachment IsNothingThen' Attachment not found, we create itSet MyAttachment = MyAttachmentType.Attachments.Add(sValue, "Imported from file: " & EXCEL_FILE, "", TEXT_TYPE)
Debug.Print"Attachment created: " & MyAttachmentType.Name & " \ " & MyAttachment.NameElse
Debug.Print"Attachment found: " & MyAttachmentType.Name & " \ " & MyAttachment.NameEndIf
lNbAttachmentsManaged += 1
sDescription = Trim(CStr(range.Cells(lCurRow, 3).Value))
If sDescription <> ""Then
MyAttachment.Description = sDescription
EndIf
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, ",")
ForEach sValue In splitted
MyAttachment.TextList.Add(sValue)
Next sValue
EndIf
sDefault = Trim(CStr(range.Cells(lCurRow, 5).Value))
If (sDefault <> "") Then' Convert/Format the value to a stringSelectCase 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))
EndSelect
MyAttachment.ValueDefault = sDefault
EndIf
EndIf
EndIfNext lCurRow
ImportAttachments = lNbAttachmentsManaged
EndFunction
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
'---------------------------------------------------------------------------
OptionExplicit
PublicConst ENTITIES$ = "Entities"PublicConst TABLES$ = "Tables"PublicConst ATTRIBUTES$ = "Attributes"PublicConst COLUMNS$ = "Columns"
Sub main
OnErrorGoTo ErrorEnd
DiagramManager.EnableScreenUpdateEx(False, False)
Debug.Clear
BindAttachments(False)
ErrorEnd:
DiagramManager.EnableScreenUpdateEx(True, True)
EndSub
PublicSub BindAttachments(currentModelOnly AsBoolean)
Dim MyDictionary As Dictionary
Dim MyDiagram As Diagram
Dim MyModel As Model
Set MyDiagram = DiagramManager.ActiveDiagram
IfNot MyDiagram IsNothingThenSet MyDictionary = MyDiagram.Dictionary ' Update this line to use an Enterprise Data Dictionary' Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item("My Enterprise DD")IfNot MyDictionary IsNothingThen
Debug.PrintIf currentModelOnly ThenSet MyModel = MyDiagram.ActiveModel
Debug.Print"Model: " & vbTab & MyModel.Name
BindModelAttachment(MyDictionary, MyModel)
ElseForEach MyModel In MyDiagram.Models
Debug.Print"Model: " & vbTab & MyModel.Name
BindModelAttachment(MyDictionary, MyModel)
NextEndIfEndIf
EndIf
EndSub
PrivateSub 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 IsNothing) Or (Not MyAttachmentTypeChild IsNothing) Then' Attachment Type for Entities or Attributes exists
' Bind Entities' AttachmentsForEach MyEntity In MyModel.Entities
If (Not MyAttachmentTypeParent IsNothing) Then
ForEach MyAttachment In MyAttachmentTypeParent.Attachments
MyEntity.BoundAttachments.Add(MyAttachment.ID)
Next
Debug.PrintIIf(MyModel.Logical, "Entity:" & vbTab & MyEntity.EntityName, "Table:" & vbTab & MyEntity.TableName)
EndIf
' Bind Attributes' AttachmentsIf (Not MyAttachmentTypeChild IsNothing) Then
ForEach MyAttribute In MyEntity.Attributes
ForEach MyAttachment In MyAttachmentTypeChild.Attachments
MyAttribute.BoundAttachments.Add(MyAttachment.ID)
Next
Debug.PrintIIf(MyModel.Logical, "Attribute:" & vbTab & MyAttribute.AttributeName, "Column:" & vbTab & MyAttribute.ColumnName)
Next
EndIf
Next
EndIf
Debug.Print
EndSub
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 AsObject, CurDiagram AsObject)
BindAttachments(True)
EndSub
Sub CreateAttributeHandler(CurAttribute AsObject, CurDiagram AsObject)
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))
IfNot MyAttachmentType IsNothingThen
Set MyAttribute = CurAttribute
ForEach MyAttachment In MyAttachmentType.Attachments
MyAttribute.BoundAttachments.Add(MyAttachment.ID)
Next
EndIf
EndSub
Sub CreateRelationshipHandler(CurRelationship AsObject, CurDiagram AsObject)
EndSub
Sub CreateIndexHandler(CurIndex AsObject, CurDiagram AsObject)
EndSub
Sub CreateModelHandler(CurModel AsObject, CurDiagram AsObject)
EndSub
Sub CreateSubModelHandler(CurSubModel AsObject, CurDiagram AsObject)
EndSub
Sub CreateDomainHandler(CurDomain AsObject, CurDiagram AsObject)
EndSub
Sub CreateDefaultHandler(CurDefault AsObject, CurDiagram AsObject)
EndSub
Sub CreateUserDatatypeHandler(CurUserDatatype AsObject, CurDiagram AsObject)
EndSub
Sub CreateRuleHandler(CurRule AsObject, CurDiagram AsObject)
EndSub
Sub CreateViewHandler(CurView AsObject, CurDiagram AsObject)
EndSub
Sub CreateTriggerHandler(CurTrigger AsObject, CurDiagram AsObject)
EndSub
Sub CreateProcedureHandler(CurProcedure AsObject, CurDiagram AsObject)
EndSub
Sub CreateViewRelationshipHandler(CurViewRelationship AsObject, CurDiagram AsObject)
EndSub
Sub CreateDiagramHandler(CurDiagram AsObject)
' Load Attachments
MacroRun "C:\ProgramData\Idera\ERStudioDA_20.1\Macros\w\Bound attachments\wReadAttachmentsFromExcel.bas"
EndSub
Sub CreateEntityDisplayHandler(CurEntityDisplay AsObject, CurDiagram AsObject)
EndSub
Sub CreateRelationshipDisplayHandler(CurRelationshipDisplay AsObject, CurDiagram AsObject)
EndSub
Sub CreateViewDisplayHandler(CurViewDisplay AsObject, CurDiagram AsObject)
EndSub
Sub CreateViewRelationshipDisplayHandler(CurViewRelationshipDisplay AsObject, CurDiagram AsObject)
EndSub
Sub CreateViewFieldHandler(CurViewField AsObject, CurDiagram AsObject)
EndSub
Sub CreateFKColumnPairHandler(CurFKColumnPair AsObject, CurDiagram AsObject)
EndSub
Sub CreateIndexColumnHandler(CurIndexColumn AsObject, CurDiagram AsObject)
EndSub
Sub CreateSubTypeHandler(CurSubType AsObject, CurDiagram AsObject)
EndSub
Sub CreateSubTypeClusterHandler(CurSubTypeCluster AsObject, CurDiagram AsObject)
EndSub
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:
William W.
Keep SQL Server Fast, Reliable and Secure - with SQL Diagnostic Manager