data modeling

Macros – Add custom properties to specific objects

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,...

Written By: William W.
Last Updated: April 9, 2024
42 minutes read

Macros – Add custom properties to specific objects

TABLE OF CONTENTS

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:

William W.

free_trial_icon-Idera_v2 2

Keep SQL Server Fast, Reliable and Secure - with SQL Diagnostic Manager

Real time monitoring
Diagnose blocking, deadlocks, bottlenecks
Powerful dashboards, customizable reports
Proactive alerts to prevent downtime
Optimize performance across servers

Start a Free Trial

Must Read

Related Articles

Ready? Join 100k+ IDERA Users

Contact our sales team to get a personalized demo of our database management software for SQL Server!

Get a Demo Contact Sales