Some years ago, Sultan shared a post regarding Data Vault modeling with ER/Studio. I strongly recommend to read it before this one.
The different Data Vault providers implement common objects but the attributes can differ. In this blog post, I’ll share an archive with some macros which can create:
- hubs: select one entity|table, run the macro to select the business keys and generate the hub
- satellites: select one entity|table, run the macro to select the changing attributes|columns and generate the satellite
- links: select 2+ hubs, run the macro to define the name and generate the link
The folder contained in the archive provides different files:
- a file which explains how you can use the archive: Readme.txt
- some screenshots (*.png)
- the macros:
- wCreate DataVault Object.bas: a macro which calls one of the 3 following ones
- wHub.bas: a macro to create a Hub from an Entity
- wSatellite.bas: a macro to create a Satellite from an Entity
- wLink.bas: a macro to create a Link from Hub(s)
- _wDataVault.bas.hidden: a macro used by the 3 previous ones
You’ll need to copy all the macro files (*.bas & _wDataVault.bas.hidden) in a subfolder of the directory of your macros (by default: C:\ProgramData\Idera\ERStudioDA_xx.x\Macros).
So for example, if you extract all the files in the folder C:\ProgramData\Idera\ERStudioDA_xx.x\Macros\Raw Vault\ you should get a new folder visible in your Macro tab:
Macros
You can download the archive from here (HTTPS) or here (other site).
Then I would suggest to add some macro shortcuts in your ribbon and/or for your Entities/Tables:
Macro ribbon
Entity Macro Shortcuts
You can find more information regarding the Macro shortcuts in this blog post.
The macros to create hubs, satellites and links contain common options to create domains and to generate a visual data lineage:
Common options
Domains
Visual Data Lineage
If it doesn’t exactly match your expectations, feel free to update the scripts accordingly to your requirements.
The scripts contain comments to help you understand its different parts.
In the video below, you can see how to use the different macros and what they can create:
Below I’ll share the scripts in case you can’t download the archive which can be blocked by some firewalls as it contains scripts.
As some macros call other ones, I suggest to use the name of each macros when you create them.
wCreate DataVault Object.bas
wCreate DataVault Object
'#Language "WWB-COM" ''MACRO TITLE: wCreate DataVault Object ' MACRO VERSION: 1.1 'This macro calls other macros ' ' Release notes ' 1.1: Checks the number of selected objects in the current active submodel ' 1.0 Initial version '--------------------------------------------------------------------------- Option Explicit Const TITLE$ = "wCreate DataVault Object" Dim MyDiagram As Diagram Dim MyModel As Model Dim MySubModel As SubModel Dim iSelectedObjectsCount% Sub Main Debug.Clear Begin Dialog UserDialog 300,133,TITLE,.DlgFunction ' %GRID:10,7,1,1 OptionGroup .DVMacro OptionButton 20,35,140,14,"a Hub",.obHub ' 0 OptionButton 20,56,140,14,"a Satellite",.obSatellite ' 1 OptionButton 20,77,140,14,"a Link",.obLink ' 2 Text 10,7,270,14,"Select the type of object you want to create:",.Text1 OKButton 10,105,90,21 CancelButton 200,105,90,21 End Dialog Dim dlg As UserDialog Dim sMacro$ iSelectedObjectsCount = -1 'Get the current diagram. Set MyDiagram = DiagramManager.ActiveDiagram If Not MyDiagram Is Nothing Then 'Get the current model. Set MyModel = MyDiagram.ActiveModel If Not MyModel Is Nothing Then 'Get the current submodel. Set MySubModel = MyModel.ActiveSubModel If Not MySubModel Is Nothing Then iSelectedObjectsCount = MySubModel.SelectedObjects.Count End If End If End If If Dialog(dlg) = -1 Then Select Case dlg.DVMacro Case 0 sMacro = "Hub" Case 1 sMacro = "Satellite" Case 2 sMacro = "Link" Case Else sMacro = "" End Select If Not IsMacroAvailable(sMacro) Then Debug.Print "The macro ""w" & sMacro & ".bas"" is not available in the folder """ & MacroDir & """" sMacro = "" End If Debug.Print "Option: " & Mid(sMacro, 2) If sMacro = "" Then MsgBox "You need to select an available option!", vbExclamation, TITLE Else MacroRun MacroDir & "\w" & sMacro & ".bas" End If End If End Sub Rem See DialogFunc help topic for more information. Private Function DlgFunction(DlgItem As String, Action As Integer, SuppValue As PortInt) As Boolean Select Case Action Case 1 ' Dialog box initialization DlgEnable("obHub", IsMacroAvailable("Hub") And (iSelectedObjectsCount = 1)) DlgEnable("obSatellite", IsMacroAvailable("Satellite") And (iSelectedObjectsCount = 1)) DlgEnable("obLink", IsMacroAvailable("Link") And (iSelectedObjectsCount >= 2)) If Not DlgEnable("obHub") Then If DlgEnable("obSatellite") Then DlgValue("DVMacro", 1) Else DlgValue("DVMacro", 2) End If End If DlgEnable("OK", DlgEnable("obHub") Or DlgEnable("obSatellite") Or DlgEnable("obLink")) Case 2 If DlgItem = "OK" Then Dim sMacro$ Select Case DlgValue "DVMacro" Case 0 sMacro = "Hub" Case 1 sMacro = "Satellite" Case 2 sMacro = "Link" Case Else ' No option selected: it should not be possible sMacro = "" DlgFunction = True Exit Function End Select If Not DlgEnable("ob" & sMacro) Then MsgBox "The macro ""w" & sMacro & ".bas"" is not available in the folder """ & MacroDir & """", vbExclamation, TITLE DlgFunction = True End If End If End Select End Function Private Function IsMacroAvailable(sName$) As Boolean IsMacroAvailable = (Dir$(MacroDir & "\w" & sName & ".bas") <> "") End Function
wHub.bas
wHub
'#Language "WWB-COM" ''MACRO TITLE: wHub ' MACRO VERSION: 3.1 'This macro generates a Hub from a selected entity|table ' Dependencies: _wDataVault.bas ' ' Release notes ' 3.1: Rolenames used ' 3.0: Option to generate a Visual Data Lineage ' 2.2: Domains folders updated ' 2.1: Common functions shared with _wDataVault ' 2.0: Domains added ' 1.0 Initial version '--------------------------------------------------------------------------- '#Uses "_wDataVault.BAS.hidden" Option Explicit #Region "Constants" Const TITLE$ = "wHub" Const TIMESTAMPED As Boolean = True Const MARGIN% = 1 Const NAME_COMPARTMENT As Boolean = True Const DOMAIN_FOLDER$ = "Hub" Const DATA_FLOW_NAME$ = "Raw Vault" Const TRANSFORMATION_HK_NAME$ = "Generate HashKey for" Const TRANSFORMATION_BK_NAME$ = "Populate Business Key for" Const HASH_KEY_PREFIX$ = "HK_" Const HASH_DATATYPE$ = "CHAR" Const HASH_DATALENGTH% = 32 Const HUB_BGCOLOR& = RGB(192, 192, 255) Const HUB_FGCOLOR& = RGB(63, 63, 0) #End Region #Region "Variables" Dim aLog$() ' Array of strings for the Logs Dim laAttributes$() ' Array of strings for the Attributes Dim MyDictionary As Dictionary Dim dictionary_list$() Dim bVDL As Boolean Dim MyDiagram As Diagram Dim MyModel As Model Dim IsLogical As Boolean Dim MySubModel As SubModel Dim MyEntity As Entity Dim MyAttribute As AttributeObj Dim iLoop% Dim sParentName$ Dim sChildName$ #End Region Private Sub Work #Region "Variables" Dim iDictionarySelect% Dim MyEntityDisplay As EntityDisplay Dim theHubEnt As Entity Dim theAttr As AttributeObj Dim sHubName$ Dim sPrefix$ Dim bUseDomains As Boolean Dim MyTransformation As Transformation Dim MyTransformationField As TransformationField Dim MyTransformationDisplay As TransformationDisplay Dim MyDataFlow As DataFlow Dim MyLineageComponent As LineageComponent Dim MyDataStream As DataStream Dim sTransformationName$ #End Region LogIt "Work" DiagramManager.EnableScreenUpdateEx(False, False) DlgEnable("pbStart", False) sHubName = DlgText "tbHubName" sPrefix = DlgText "tbPrefix" bUseDomains = DlgValue "cbDomains" bVDL = DlgValue("cbVDL") If bUseDomains Then iDictionarySelect = DlgValue "dictionary_select" If dictionary_list(iDictionarySelect) = "Local" Then Set MyDictionary = MyDiagram.Dictionary Else Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(dictionary_list(iDictionarySelect)) End If End If Dim iX%, iY% Dim edf% Set MyEntityDisplay = MySubModel.EntityDisplays.Item(If(IsLogical, MyEntity.EntityName, MyEntity.TableName)) If MyEntityDisplay Is Nothing Then iX = 0 iY = 0 Else iX = MyEntityDisplay.HorizontalPosition + MARGIN iY = MyEntityDisplay.VerticalPosition + MARGIN End If Set theHubEnt = MyModel.Entities.Add(iX, iY) theHubEnt.EntityName = LCase(sPrefix & sHubName) theHubEnt.TableName = theHubEnt.EntityName theHubEnt.Note = "Hub – representing a list of unique business keys" theHubEnt.DimModelTableType = "UNDEFINED" Set theAttr = theHubEnt.Attributes.Add(LCase(HASH_KEY_PREFIX & theHubEnt.EntityName), True) UseDomain(bUseDomains, MyDictionary, DOMAIN_FOLDER, theAttr, HASH_DATATYPE, HASH_DATALENGTH) Dim s%() s = DlgValue "mlbAttributes" For iLoop = LBound(s) To UBound(s) Set MyAttribute = MyEntity.Attributes.Item(laAttributes(s(iLoop))) If Not (MyAttribute Is Nothing) Then LogIt sChildName & ": " & If(IsLogical, MyAttribute.AttributeName, MyAttribute.ColumnName) Set theAttr = theHubEnt.Attributes.Add(LCase(If(IsLogical, If(MyAttribute.HasLogicalRoleName, MyAttribute.LogicalRoleName, MyAttribute.AttributeName), If(MyAttribute.HasRoleName, MyAttribute.RoleName, MyAttribute.ColumnName))), False) theAttr.Datatype = MyAttribute.Datatype theAttr.DataLength = MyAttribute.DataLength theAttr.DataScale = MyAttribute.DataScale ' theAttr.NullOption = MyAttribute.NullOption theAttr.NullOption = "NOT NULL" theAttr.Font.Italic = True ' theAttr.Color = HUB_FGCOLOR End If Next Set theAttr = theHubEnt.Attributes.Add("dss_record_source", False) UseDomain(bUseDomains, MyDictionary, DOMAIN_FOLDER, theAttr, "VARCHAR", 256) Set theAttr = theHubEnt.Attributes.Add("dss_load_date", False) UseDomain(bUseDomains, MyDictionary, DOMAIN_FOLDER, theAttr, "DATETIME", 0) Set MyEntityDisplay = MySubModel.EntityDisplays.Item(theHubEnt.EntityName) MyEntityDisplay.BackgroundColor = HUB_BGCOLOR MyEntityDisplay.NonInheritedPrimaryKeysColor = HUB_FGCOLOR MyEntityDisplay.NonInheritedNonKeysColor = HUB_FGCOLOR MyEntityDisplay.NameColor = If(NAME_COMPARTMENT, HUB_FGCOLOR, HUB_BGCOLOR) MyEntityDisplay.DisplayBackgroundColor = True MyEntityDisplay.HorizontalPosition = iX MyEntityDisplay.VerticalPosition = iY If NAME_COMPARTMENT Then MySubModel.ShowEntityNameCompartment = NAME_COMPARTMENT edf = MySubModel.EntityDisplayFormat If (edf <> 7) And (edf <> 8) Then MySubModel.EntityDisplayFormat = If(IsLogical, 7, 8) End If End If LogIt "New hub created: " & theHubEnt.EntityName Dim l As Line Dim ld As LineDisplay Set l = MyModel.Lines.Add(1, If(IsLogical, MyEntity.EntityName, MyEntity.TableName), 1, theHubEnt.EntityName) Set ld = MySubModel.LineDisplays.Add(l.ID) If Not ld Is Nothing Then ld.Color = HUB_BGCOLOR End If #Region "Visual Data Lineage" ' Manage Visual Data Lineage If bVDL Then Set MyDataFlow = MyDiagram.DataFlows.Item(DATA_FLOW_NAME) If MyDataFlow Is Nothing Then 'data flow doesn't exist so create it Set MyDataFlow = MyDiagram.DataFlows.Add(DATA_FLOW_NAME) End If If MyDataFlow Is Nothing Then 'if the object is still not initialized something happened when creating it. log error to log file LogIt "Data Flow <" & DATA_FLOW_NAME & "> could not be created." LogIt DiagramManager.GetLastErrorString Else ' Add Tranformation for the HashKey sTransformationName = TRANSFORMATION_HK_NAME & " " & theHubEnt.EntityName 'after the data flow is created, create the transformation Set MyTransformationDisplay = MyDataFlow.TransformationDisplays.Item(sTransformationName) Set MyTransformation = MyDataFlow.Transformations.Item(sTransformationName) If MyTransformation Is Nothing And MyTransformationDisplay Is Nothing Then 'if neither the display or object exist add it to the data flow Set MyTransformation = MyDataFlow.Transformations.Add(300, 200) If MyTransformation Is Nothing Then 'log missing transformation in the error string LogIt "Transformation <" & sTransformationName & "> could not be created." LogIt DiagramManager.GetLastErrorString Else 'set the name and display object MyTransformation.Name = sTransformationName Set MyTransformationDisplay = MyDataFlow.TransformationDisplays.Item(sTransformationName) 'set the other transformation properties MyTransformation.Type = "Calculation" MyTransformation.BusinessDefinition = "Calculate HashKey from the Business Keys " & sChildName & "s" MyTransformation.CodeDefinition = "INSERT INTO " & theHubEnt.EntityName & " (" & LCase(HASH_KEY_PREFIX & theHubEnt.EntityName) & ")" ' Add the source 'see if the lineage component exists in the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.ItemBySource(1, MyEntity.ID) If MyLineageComponent Is Nothing Then ' Add the object to the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.Add(1, MyEntity.ID, 1, 305) End If ' Add data stream between source & transformation Set MyDataStream = MyDataFlow.DataStreams.Add(MyTransformation.Name, MyLineageComponent.ID, True) If MyDataStream Is Nothing And Not(MyLineageComponent Is Nothing) Then 'log to error file LogIt "Data Stream between <" & MyLineageComponent.Name & "> and <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'now add the input columns For iLoop = LBound(s) To UBound(s) Set theAttr = MyEntity.Attributes.Item(laAttributes(s(iLoop))) If theAttr Is Nothing Then 'log to error file if column doesn't exist LogIt "Model " & sChildName & " <" & laAttributes(s(iLoop)) & "> could not be found in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'set input column based on attribute Set MyTransformationField = MyTransformation.LineageInputs.Add(5, theAttr.ID) If MyTransformationField Is Nothing Then 'log to error file LogIt "Transformation Input <" & laAttributes(s(iLoop)) & "> between Lineage Component <" & MyLineageComponent.Name & "> and Transformation <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString End If End If 'transformation existence check Next iLoop End If ' data stream ' Add the target 'see if the lineage component exists in the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.ItemBySource(1, theHubEnt.ID) If MyLineageComponent Is Nothing Then ' Add the object to the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.Add(1, theHubEnt.ID, 650, 300) End If ' Add data stream between source & transformation Set MyDataStream = MyDataFlow.DataStreams.Add(MyTransformation.Name, MyLineageComponent.ID, False) If MyDataStream Is Nothing And Not(MyLineageComponent Is Nothing) Then 'log to error file LogIt "Data Stream between <" & MyLineageComponent.Name & "> and <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'now add the output columns Set theAttr = theHubEnt.Attributes.Item(LCase(HASH_KEY_PREFIX & theHubEnt.EntityName)) If theAttr Is Nothing Then 'log to error file if column doesn't exist LogIt "Model " & sChildName & " <" & LCase(HASH_KEY_PREFIX & theHubEnt.EntityName) & "> could not be found in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'set output column based on attribute Set MyTransformationField = MyTransformation.LineageOutputs.Add(5, theAttr.ID) If MyTransformationField Is Nothing Then 'log to error file LogIt "Transformation Output <" & LCase(HASH_KEY_PREFIX & theHubEnt.EntityName) & "> between Lineage Component <" & MyLineageComponent.Name & "> and Transformation <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString End If End If 'transformation existence check End If ' data stream End If ' tran is nothing End If 'tran and tran display check ' Add Tranformation for the Business Keys sTransformationName = TRANSFORMATION_BK_NAME & " " & theHubEnt.EntityName ' After the data flow is created, create the transformation Set MyTransformationDisplay = MyDataFlow.TransformationDisplays.Item(sTransformationName) Set MyTransformation = MyDataFlow.Transformations.Item(sTransformationName) If MyTransformation Is Nothing And MyTransformationDisplay Is Nothing Then 'if neither the display or object exist add it to the data flow Set MyTransformation = MyDataFlow.Transformations.Add(300, 400) If MyTransformation Is Nothing Then 'log missing transformation in the error string LogIt "Transformation <" & sTransformationName & "> could not be created." LogIt DiagramManager.GetLastErrorString Else 'set the name and display object MyTransformation.Name = sTransformationName Set MyTransformationDisplay = MyDataFlow.TransformationDisplays.Item(sTransformationName) 'set the other transformation properties MyTransformation.Type = "Select Into" MyTransformation.BusinessDefinition = "Copy the Business Keys values" MyTransformation.CodeDefinition = "INSERT INTO " & theHubEnt.EntityName & " " & vbCrLf & "SELECT * FROM " & If(IsLogical, MyEntity.EntityName, MyEntity.TableName) & vbCrLf & "WHERE " ' Add the source 'see if the lineage component exists in the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.ItemBySource(1, MyEntity.ID) If MyLineageComponent Is Nothing Then ' Add the object to the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.Add(1, MyEntity.ID, 100, 100) End If ' Add data stream between source & transformation Set MyDataStream = MyDataFlow.DataStreams.Add(MyTransformation.Name, MyLineageComponent.ID, True) If MyDataStream Is Nothing And Not(MyLineageComponent Is Nothing) Then 'log to error file LogIt "Data Stream between <" & MyLineageComponent.Name & "> and <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'now add the input columns For iLoop = LBound(s) To UBound(s) Set theAttr = MyEntity.Attributes.Item(laAttributes(s(iLoop))) If theAttr Is Nothing Then 'log to error file if column doesn't exist LogIt "Model " & sChildName & " <" & laAttributes(s(iLoop)) & "> could not be found in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'set input column based on attribute Set MyTransformationField = MyTransformation.LineageInputs.Add(5, theAttr.ID) If MyTransformationField Is Nothing Then 'log to error file LogIt "Transformation Input <" & laAttributes(s(iLoop)) & "> between Lineage Component <" & MyLineageComponent.Name & "> and Transformation <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString End If End If 'transformation existence check Next iLoop End If ' data stream ' Add the target 'see if the lineage component exists in the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.ItemBySource(1, theHubEnt.ID) If MyLineageComponent Is Nothing Then ' Add the object to the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.Add(1, theHubEnt.ID, 100, 100) End If ' Add data stream between source & transformation Set MyDataStream = MyDataFlow.DataStreams.Add(MyTransformation.Name, MyLineageComponent.ID, False) If MyDataStream Is Nothing And Not(MyLineageComponent Is Nothing) Then 'log to error file LogIt "Data Stream between <" & MyLineageComponent.Name & "> and <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'now add the output columns For iLoop = LBound(s) To UBound(s) Set MyAttribute = MyEntity.Attributes.Item(laAttributes(s(iLoop))) If MyAttribute Is Nothing Then 'log to error file LogIt sChildName & " <" & laAttributes(s(iLoop)) & "> could not be found in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else Set theAttr = theHubEnt.Attributes.Item(LCase(If(IsLogical, MyAttribute.AttributeName, MyAttribute.ColumnName))) If theAttr Is Nothing Then 'log to error file if column doesn't exist LogIt "Model " & sChildName & " <" & LCase(If(IsLogical, MyAttribute.AttributeName, MyAttribute.ColumnName)) & "> could not be found in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'set output column based on attribute Set MyTransformationField = MyTransformation.LineageOutputs.Add(5, theAttr.ID) If MyTransformationField Is Nothing Then 'log to error file LogIt "Transformation Output <" & laAttributes(s(iLoop)) & "> between Lineage Component <" & MyLineageComponent.Name & "> and Transformation <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString End If End If 'transformation existence check End If Next iLoop End If ' data stream End If ' tran is nothing End If 'tran and tran display check End If 'data flow existence check End If ' Visual Data Lineage #End Region ' Job finished MySubModel.ActivateSubModel MySubModel.SelectedObjects.Add(1, MyEntity.ID) DiagramManager.EnableScreenUpdateEx(True, True) DlgText("pbStart", "Completed") End Sub Sub Main On Error GoTo errHandler Dim MySelectedObject As SelectedObject InitCommonVars(aLog, MyDiagram, MyModel, MySubModel, IsLogical, sParentName, sChildName) ReDim laAttributes(0) If MySubModel.SelectedObjects.Count <> 1 Then MsgBox "Error:" & vbCrLf & vbCrLf & "You can only select ONE " & sParentName & "!", vbExclamation, TITLE Exit Sub End If For Each MySelectedObject In MySubModel.SelectedObjects If MySelectedObject.Type <> 1 Then MsgBox "Error:" & vbCrLf & vbCrLf & "You can only select one " & UCase(sParentName) & "!", vbExclamation, TITLE Exit Sub End If Set MyEntity = MyModel.Entities.Item(MySelectedObject.ID) ' LogIt "Selected " & sParentName & ": " & MyEntity.EntityName iLoop = 0 ReDim laAttributes(0 To MyEntity.Attributes.Count) For Each MyAttribute In MyEntity.Attributes laAttributes(iLoop) = If(IsLogical, If(MyAttribute.HasLogicalRoleName, MyAttribute.LogicalRoleName, MyAttribute.AttributeName), If(MyAttribute.HasRoleName, MyAttribute.RoleName, MyAttribute.ColumnName)) iLoop = iLoop + 1 Next MyAttribute Next MySelectedObject Begin Dialog UserDialog 770,420,TITLE,.DialogFunc ' %GRID:10,7,1,1 Text 30,7,110,14,"Hub Name:",.hubCaption,1 TextBox 160,5,600,18,.tbHubName Text 30,28,110,14,"Prefix:",.prefixCaption,1 TextBox 160,26,600,18,.tbPrefix GroupBox 10,49,750,119,"Attributes",.gbAttributes MultiListBox 20,63,730,98,laAttributes(),.mlbAttributes,1 CheckBox 20,175,730,14,"Domains for common Data Vault attributes/columns",.cbDomains Text 20,196,120,14,"Select Dictionary: ",.tDictionary,1 DropListBox 160,193,590,112,dictionary_list(),.dictionary_select CheckBox 20,217,730,14,"Generate Visual Data Lineage",.cbVDL PushButton 350,238,90,21,"Start",.pbStart ListBox 20,266,740,112,aLog(),.lbLog,1 PushButton 20,392,90,21,"Blog post",.pbBlog PushButton 350,392,90,21,"Close",.cbCancel CancelButton 355,695,80,15 ' out of screen: allow to close the dialog with the X End Dialog Dim dlg As UserDialog init_dictionary_list(dictionary_list, MyDiagram, MyDictionary) dlg.tbHubName = LCase(If(IsLogical, MyEntity.EntityName, MyEntity.TableName)) dlg.tbPrefix = "h_" dlg.cbDomains = True dlg.cbVDL = True dlg.dictionary_select = UBound(dictionary_list) 'Default DD = Latest one: if only one, it's the local one, otherwise, an EDD Dialog dlg Exit Sub errHandler: ManageError(Err, TITLE, TIMESTAMPED) End Sub Private Function DialogFunc(DlgItem$, Action%, SuppValue&) As Boolean Dim i% Dim iLoop% Dim s%() Select Case Action% Case 1 ' Dialog box initialization InitDialog("tbHubName", MyDiagram, MyModel, MySubModel, aLog, TIMESTAMPED) DlgText("gbAttributes", "Select Business Key(s) " & sChildName & "s") DlgText("cbDomains", "Domains for common Data Vault " & If(IsLogical, "Attributes", "Columns")) Case 2 ' Value changing or button pressed DialogFunc = DialogControlUpdated("tbHubName", DlgItem) If DlgItem = "pbStart" Then Work End If Case 3 ' TextBox or ComboBox text changed RefreshButtonStart("tbHubName") End Select End Function Private Sub LogIt(ByVal txt As String) Log(txt, aLog, TIMESTAMPED) End Sub
wSatellite.bas
wSatellite
'#Language "WWB-COM" ''MACRO TITLE: wSatellite ' MACRO VERSION: 3.1 'This macro generates a Satellite from a selected entity|table ' Pre-requisites: To generate the relationship between the Hub & the ' Satellite, you need to run the wHub macro first. ' Dependencies: _wDataVault.bas ' ' Release notes ' 3.1: Rolenames used ' 3.0: Option to generate a Visual Data Lineage ' 2.2: Domains folders updated ' 2.1: Common functions shared with _wDataVault ' 2.0: Domains added ' 1.0 Initial version '--------------------------------------------------------------------------- '#Uses "_wDataVault.BAS.hidden" Option Explicit #Region "Constants" Const TITLE As String = "wSatellite" Const TIMESTAMPED As Boolean = True Const MARGIN% = 1 Const NAME_COMPARTMENT As Boolean = True Const DOMAIN_FOLDER$ = "Satellite" Const DATA_FLOW_NAME$ = "Raw Vault" Const TRANSFORMATION_NAME$ = "Populate" Const HASH_KEY_PREFIX$ = "HK_" Const HASH_DATATYPE$ = "CHAR" Const HASH_DATALENGTH% = 32 Const SAT_BGCOLOR& = RGB(255, 255, 192) Const SAT_FGCOLOR& = RGB(0, 0, 63) #End Region #Region "Variables" Dim aLog$() ' Array of strings for the Logs Dim laAttributes$() ' Array of strings for the Attributes Dim MyDictionary As Dictionary Dim dictionary_list$() Dim bVDL As Boolean Dim MyDiagram As Diagram Dim MyModel As Model Dim IsLogical As Boolean Dim MyEntity As Entity Dim MySubModel As SubModel Dim MyAttribute As AttributeObj Dim MySelectedObject As SelectedObject Dim iLoop% Dim sParentName$ Dim sChildName$ #End Region Private Sub Work #Region "Variables" Dim iDictionarySelect% Dim MyEntityDisplay As EntityDisplay Dim theSatelliteEnt As Entity Dim theAttr As AttributeObj Dim sSatelliteName$ Dim sPrefix$, sSuffix$ Dim bUseDomains As Boolean Dim MyTransformation As Transformation Dim MyTransformationField As TransformationField Dim MyTransformationDisplay As TransformationDisplay Dim MyDataFlow As DataFlow Dim MyLineageComponent As LineageComponent Dim MyDataStream As DataStream Dim sTransformationName$ Dim eParentHub As Entity Dim rHubSat As Relationship Dim iX%, iY% Dim edf% Dim s%() #End Region LogIt "Work" DiagramManager.EnableScreenUpdateEx(False, False) DlgEnable("pbStart", False) sSatelliteName = DlgText "tbSatelliteName" sPrefix = DlgText "tbPrefix" sSuffix = DlgText "tbSuffix" bUseDomains = DlgValue "cbDomains" bVDL = DlgValue("cbVDL") If bUseDomains Then iDictionarySelect = DlgValue "dictionary_select" If dictionary_list(iDictionarySelect) = "Local" Then Set MyDictionary = MyDiagram.Dictionary Else Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(dictionary_list(iDictionarySelect)) End If End If Set MyEntityDisplay = MySubModel.EntityDisplays.Item(If(IsLogical, MyEntity.EntityName, MyEntity.TableName)) If MyEntityDisplay Is Nothing Then iX = 0 iY = 0 Else iX = MyEntityDisplay.HorizontalPosition + MARGIN iY = MyEntityDisplay.VerticalPosition + MARGIN End If Set theSatelliteEnt = MyModel.Entities.Add(iX, iY) theSatelliteEnt.EntityName = LCase(sPrefix & sSatelliteName & sSuffix) theSatelliteEnt.TableName = theSatelliteEnt.EntityName theSatelliteEnt.Note = "Satellites – contain descriptions and the contexts of the business keys or links" theSatelliteEnt.DimModelTableType = "UNDEFINED" Set eParentHub = MyModel.Entities(LCase("h_" & sSatelliteName)) If eParentHub Is Nothing Then LogIt "Hub has not been found. You should use the wHub macro before using this one." Set theAttr = theSatelliteEnt.Attributes.Add(LCase(HASH_KEY_PREFIX & "h_" & sSatelliteName), True) UseDomain(bUseDomains, MyDictionary, DOMAIN_FOLDER, theAttr, HASH_DATATYPE, HASH_DATALENGTH) Else Set rHubSat = MyModel.Relationships.Add(eParentHub.EntityName, theSatelliteEnt.EntityName, 0) End If s = DlgValue "mlbAttributes" For iLoop = LBound(s) To UBound(s) Set MyAttribute = MyEntity.Attributes.Item(laAttributes(s(iLoop))) If Not (MyAttribute Is Nothing) Then LogIt sChildName & ": " & If(IsLogical, MyAttribute.AttributeName, MyAttribute.ColumnName) Set theAttr = theSatelliteEnt.Attributes.Add(LCase(If(IsLogical, If(MyAttribute.HasLogicalRoleName, MyAttribute.LogicalRoleName, MyAttribute.AttributeName), If(MyAttribute.HasRoleName, MyAttribute.RoleName, MyAttribute.ColumnName))), False) theAttr.Datatype = MyAttribute.Datatype theAttr.DataLength = MyAttribute.DataLength theAttr.DataScale = MyAttribute.DataScale theAttr.NullOption = "NOT NULL" ' theAttr.NullOption = MyAttribute.NullOption theAttr.Font.Italic = True ' theAttr.Color = SAT_FGCOLOR End If Next Set theAttr = theSatelliteEnt.Attributes.Add("dss_change_hash", False) theAttr.Datatype = HASH_DATATYPE theAttr.DataLength = HASH_DATALENGTH ' theAttr.Color = SAT_FGCOLOR Set theAttr = theSatelliteEnt.Attributes.Add("dss_record_source", False) UseDomain(bUseDomains, MyDictionary, DOMAIN_FOLDER, theAttr, "VARCHAR", 256) Set theAttr = theSatelliteEnt.Attributes.Add("dss_load_date", False) UseDomain(bUseDomains, MyDictionary, DOMAIN_FOLDER, theAttr, "DATETIME", 0) Set theAttr = theSatelliteEnt.Attributes.Add("dss_start_date", True) UseDomain(bUseDomains, MyDictionary, DOMAIN_FOLDER, theAttr, "DATETIME", 0) Set theAttr = theSatelliteEnt.Attributes.Add("dss_version", False) UseDomain(bUseDomains, MyDictionary, DOMAIN_FOLDER, theAttr, "INTEGER", 0) Set MyEntityDisplay = MySubModel.EntityDisplays.Item(theSatelliteEnt.EntityName) ' DiagramManager.EnableScreenUpdateEx(False, False) MyEntityDisplay.BackgroundColor = SAT_BGCOLOR MyEntityDisplay.InheritedPrimaryKeysColor = SAT_FGCOLOR MyEntityDisplay.NonInheritedPrimaryKeysColor = SAT_FGCOLOR MyEntityDisplay.NonInheritedNonKeysColor = SAT_FGCOLOR MyEntityDisplay.NameColor = If(NAME_COMPARTMENT, SAT_FGCOLOR, SAT_BGCOLOR) MyEntityDisplay.DisplayBackgroundColor = True MyEntityDisplay.HorizontalPosition = iX MyEntityDisplay.VerticalPosition = iY If NAME_COMPARTMENT Then MySubModel.ShowEntityNameCompartment = NAME_COMPARTMENT edf = MySubModel.EntityDisplayFormat If (edf <> 7) And (edf <> 8) Then MySubModel.EntityDisplayFormat = If(IsLogical, 7, 8) End If End If ' DiagramManager.EnableScreenUpdateEx(True, True) LogIt "New satellite created: " & theSatelliteEnt.EntityName Dim l As Line Dim ld As LineDisplay Set l = MyModel.Lines.Add(1, If(IsLogical, MyEntity.EntityName, MyEntity.TableName), 1, theSatelliteEnt.EntityName) Set ld = MySubModel.LineDisplays.Add(l.ID) If Not ld Is Nothing Then ld.Color = SAT_BGCOLOR End If #Region "Visual Data Lineage" ' Manage Visual Data Lineage If bVDL Then If eParentHub Is Nothing Then LogIt "Visual Data Lineage not generated without the Hub" Else Set MyDataFlow = MyDiagram.DataFlows.Item(DATA_FLOW_NAME) If MyDataFlow Is Nothing Then 'data flow doesn't exist so create it Set MyDataFlow = MyDiagram.DataFlows.Add(DATA_FLOW_NAME) End If If MyDataFlow Is Nothing Then 'if the object is still not initialized something happened when creating it. log error to log file LogIt "Data Flow <" & DATA_FLOW_NAME & "> could not be created." LogIt DiagramManager.GetLastErrorString Else ' Add Tranformation for the HashKey sTransformationName = TRANSFORMATION_NAME & " " & theSatelliteEnt.EntityName 'after the data flow is created, create the transformation Set MyTransformationDisplay = MyDataFlow.TransformationDisplays.Item(sTransformationName) Set MyTransformation = MyDataFlow.Transformations.Item(sTransformationName) If MyTransformation Is Nothing And MyTransformationDisplay Is Nothing Then 'if neither the display or object exist add it to the data flow Set MyTransformation = MyDataFlow.Transformations.Add(900, 200) If MyTransformation Is Nothing Then 'log missing transformation in the error string LogIt "Transformation <" & sTransformationName & "> could not be created." LogIt DiagramManager.GetLastErrorString Else 'set the name and display object MyTransformation.Name = sTransformationName Set MyTransformationDisplay = MyDataFlow.TransformationDisplays.Item(sTransformationName) 'set the other transformation properties MyTransformation.Type = "Select Into" MyTransformation.BusinessDefinition = "Copy descriptions and contexts" MyTransformation.CodeDefinition = "INSERT INTO " & theSatelliteEnt.EntityName & " (" & LCase(HASH_KEY_PREFIX & eParentHub.EntityName) & ", ...)" ' Add the 1st source 'see if the lineage component exists in the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.ItemBySource(1, eParentHub.ID) If MyLineageComponent Is Nothing Then ' Add the object to the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.Add(1, eParentHub.ID, 650, 300) End If ' Add data stream between source & transformation Set MyDataStream = MyDataFlow.DataStreams.Add(MyTransformation.Name, MyLineageComponent.ID, True) If MyDataStream Is Nothing And Not(MyLineageComponent Is Nothing) Then 'log to error file LogIt "Data Stream between <" & MyLineageComponent.Name & "> and <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'now add the input column Set theAttr = eParentHub.Attributes.Item(LCase(HASH_KEY_PREFIX & eParentHub.EntityName)) If theAttr Is Nothing Then 'log to error file if column doesn't exist LogIt "Model " & sChildName & " <" & LCase(HASH_KEY_PREFIX & eParentHub.EntityName) & "> could not be found in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'set input column based on attribute Set MyTransformationField = MyTransformation.LineageInputs.Add(5, theAttr.ID) If MyTransformationField Is Nothing Then 'log to error file LogIt "Transformation Output <" & LCase(HASH_KEY_PREFIX & eParentHub.EntityName) & "> between Lineage Component <" & MyLineageComponent.Name & "> and Transformation <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString End If End If End If ' data stream ' Add the 2nd source 'see if the lineage component exists in the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.ItemBySource(1, MyEntity.ID) If MyLineageComponent Is Nothing Then ' Add the object to the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.Add(1, MyEntity.ID, 0, 300) End If ' Add data stream between source & transformation Set MyDataStream = MyDataFlow.DataStreams.Add(MyTransformation.Name, MyLineageComponent.ID, True) If MyDataStream Is Nothing And Not(MyLineageComponent Is Nothing) Then 'log to error file LogIt "Data Stream between <" & MyLineageComponent.Name & "> and <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'now add the input columns For iLoop = LBound(s) To UBound(s) Set theAttr = MyEntity.Attributes.Item(laAttributes(s(iLoop))) If theAttr Is Nothing Then 'log to error file if column doesn't exist LogIt "Model " & sChildName & " <" & laAttributes(s(iLoop)) & "> could not be found in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'set input column based on attribute Set MyTransformationField = MyTransformation.LineageInputs.Add(5, theAttr.ID) If MyTransformationField Is Nothing Then 'log to error file LogIt "Transformation Input <" & laAttributes(s(iLoop)) & "> between Lineage Component <" & MyLineageComponent.Name & "> and Transformation <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString End If End If 'transformation existence check Next iLoop End If ' data stream ' Add the target 'see if the lineage component exists in the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.ItemBySource(1, theSatelliteEnt.ID) If MyLineageComponent Is Nothing Then ' Add the object to the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.Add(1, theSatelliteEnt.ID, 1300, 300) End If ' Add data stream between source & transformation Set MyDataStream = MyDataFlow.DataStreams.Add(MyTransformation.Name, MyLineageComponent.ID, False) If MyDataStream Is Nothing And Not(MyLineageComponent Is Nothing) Then 'log to error file LogIt "Data Stream between <" & MyLineageComponent.Name & "> and <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'now add the output column for hashkey Set theAttr = theSatelliteEnt.Attributes.Item(LCase(HASH_KEY_PREFIX & eParentHub.EntityName)) If theAttr Is Nothing Then 'log to error file if column doesn't exist LogIt "Model " & sChildName & " <" & LCase(HASH_KEY_PREFIX & eParentHub.EntityName) & "> could not be found in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'set output column based on attribute Set MyTransformationField = MyTransformation.LineageOutputs.Add(5, theAttr.ID) If MyTransformationField Is Nothing Then 'log to error file LogIt "Transformation Output <" & LCase(HASH_KEY_PREFIX & eParentHub.EntityName) & "> between Lineage Component <" & MyLineageComponent.Name & "> and Transformation <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString End If End If 'transformation existence check ' Add the other columns 'now add the output columns For iLoop = LBound(s) To UBound(s) Set MyAttribute = MyEntity.Attributes.Item(laAttributes(s(iLoop))) If MyAttribute Is Nothing Then 'log to error file LogIt sChildName & " <" & laAttributes(s(iLoop)) & "> could not be found in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else Set theAttr = theSatelliteEnt.Attributes.Item(LCase(If(IsLogical, MyAttribute.AttributeName, MyAttribute.ColumnName))) If theAttr Is Nothing Then 'log to error file if column doesn't exist LogIt "Model " & sChildName & " <" & LCase(If(IsLogical, MyAttribute.AttributeName, MyAttribute.ColumnName)) & "> could not be found in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'set output column based on attribute Set MyTransformationField = MyTransformation.LineageOutputs.Add(5, theAttr.ID) If MyTransformationField Is Nothing Then 'log to error file LogIt "Transformation Output <" & laAttributes(s(iLoop)) & "> between Lineage Component <" & MyLineageComponent.Name & "> and Transformation <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString End If End If 'transformation existence check End If Next iLoop End If ' data stream End If ' tran is nothing End If 'tran and tran display check End If 'data flow existence check End If ' Hub created before using this macro End If ' Visual Data Lineage #End Region ' Job finished MySubModel.ActivateSubModel MySubModel.SelectedObjects.Add(1, MyEntity.ID) MySubModel.ActivateSubModel DiagramManager.EnableScreenUpdateEx(True, True) End Sub Sub Main On Error GoTo errHandler InitCommonVars(aLog, MyDiagram, MyModel, MySubModel, IsLogical, sParentName, sChildName) ReDim laAttributes(0) If MySubModel.SelectedObjects.Count <> 1 Then MsgBox "Error:" & vbCrLf & vbCrLf & "You can only select ONE " & sParentName & "!", vbExclamation, TITLE Exit Sub End If For Each MySelectedObject In MySubModel.SelectedObjects If MySelectedObject.Type <> 1 Then MsgBox "Error:" & vbCrLf & vbCrLf & "You can only select one " & UCase(sParentName) & "!", vbExclamation, TITLE Exit Sub End If Set MyEntity = MyModel.Entities.Item(MySelectedObject.ID) ' LogIt "Selected " & sParentName & ": " & MyEntity.EntityName iLoop = 0 ReDim laAttributes(0 To MyEntity.Attributes.Count) For Each MyAttribute In MyEntity.Attributes laAttributes(iLoop) = If(IsLogical, If(MyAttribute.HasLogicalRoleName, MyAttribute.LogicalRoleName, MyAttribute.AttributeName), If(MyAttribute.HasRoleName, MyAttribute.RoleName, MyAttribute.ColumnName)) iLoop = iLoop + 1 Next MyAttribute Next MySelectedObject Begin Dialog UserDialog 770,420,TITLE,.DialogFunc ' %GRID:10,7,1,1 Text 30,7,110,14,"Satellite Name:",.satelliteCaption,1 TextBox 160,5,600,18,.tbSatelliteName Text 30,28,110,14,"Prefix:",.prefixCaption,1 TextBox 160,26,600,18,.tbPrefix Text 30,49,110,14,"Suffix:",.suffixCaption,1 TextBox 160,47,600,18,.tbSuffix GroupBox 10,77,750,119,"Attributes",.gbAttributes MultiListBox 20,91,730,98,laAttributes(),.mlbAttributes,1 CheckBox 20,203,730,14,"Domains for common Data Vault attributes/columns",.cbDomains Text 20,224,120,14,"Select Dictionary: ",.tDictionary,1 DropListBox 160,221,590,112,dictionary_list(),.dictionary_select CheckBox 20,245,730,14,"Generate Visual Data Lineage",.cbVDL PushButton 350,273,90,21,"Start",.pbStart ListBox 20,301,740,77,aLog(),.lbLog,1 PushButton 20,392,90,21,"Blog post",.pbBlog PushButton 350,392,90,21,"Close",.cbCancel CancelButton 355,695,80,15 ' out of screen: allow to close the dialog with the X End Dialog Dim dlg As UserDialog init_dictionary_list(dictionary_list, MyDiagram, MyDictionary) dlg.tbSatelliteName = LCase(If(IsLogical, MyEntity.EntityName, MyEntity.TableName)) dlg.tbPrefix = "s_" dlg.tbSuffix = "_lroc" dlg.cbDomains = True dlg.cbVDL = True dlg.dictionary_select = UBound(dictionary_list) 'Default DD = Latest one: if only one, it's the local one, otherwise, an EDD Dialog dlg Exit Sub errHandler: ManageError(Err, TITLE, TIMESTAMPED) End Sub Private Function DialogFunc(DlgItem$, Action%, SuppValue&) As Boolean Dim i%, iLoop%, s%() Select Case Action% Case 1 ' Dialog box initialization InitDialog("tbSatelliteName", MyDiagram, MyModel, MySubModel, aLog, TIMESTAMPED) DlgText("gbAttributes", "Select Changing " & sChildName & "s") Case 2 ' Value changing or button pressed DialogFunc = DialogControlUpdated("tbSatelliteName", DlgItem) If DlgItem = "pbStart" Then Work End If Case 3 ' TextBox or ComboBox text changed RefreshButtonStart("tbSatelliteName") End Select End Function Private Sub LogIt(ByVal txt As String) Log(txt, aLog, TIMESTAMPED) End Sub
wLink.bas
wLink
'#Language "WWB-COM" ''MACRO TITLE: wLink ' MACRO VERSION: 3.1 'This macro generates a Link from selected hubs and|or satellites ' Pre-requisites: You need to select the Hubs (2+) before you run the macro. ' Dependencies: _wDataVault.bas ' ' Release notes ' 3.1: Satellites can be used to create a Link ' 3.0: Option to generate a Visual Data Lineage ' 2.2: Domains folders updated ' 2.1: Common functions shared with _wDataVault ' 2.0: Domains added ' 1.0 Initial version '--------------------------------------------------------------------------- '#Uses "_wDataVault.BAS.hidden" Option Explicit #Region "Constants" Const TITLE As String = "wLink" Const TIMESTAMPED As Boolean = True Const MARGIN% = 1 Const NAME_COMPARTMENT As Boolean = True Const DOMAIN_FOLDER$ = "Link" Const DATA_FLOW_NAME$ = "Raw Vault" Const TRANSFORMATION_NAME$ = "Populate " Const HASH_KEY_PREFIX$ = "HK_" Const HASH_DATATYPE$ = "CHAR" Const HASH_DATALENGTH% = 32 'Const HUB_PREFIX$ = "h_" Const LINK_BGCOLOR& = RGB(255, 192, 192) Const LINK_FGCOLOR& = RGB(0, 63, 63) #End Region #Region "Variables" Dim aLog$() ' Array of strings for the Logs Dim laHub() As Entity ' Array of Entity for the Hubs Dim laHubName$() ' Array of strings for the Hubs names Dim MyDictionary As Dictionary Dim dictionary_list$() Dim bVDL As Boolean Dim MyDiagram As Diagram Dim MyModel As Model Dim IsLogical As Boolean Dim MySubModel As SubModel Dim MySelectedObject As SelectedObject Dim iLoop% Dim sParentName$, sParentsName$ Dim sChildName$ #End Region Private Sub Work #Region "Variables" Dim iDictionarySelect% Dim MyEntityDisplay As EntityDisplay Dim theLinkEnt As Entity Dim theAttr As AttributeObj Dim sLinkName$ Dim sPrefix$ Dim bUseDomains As Boolean Dim MyTransformation As Transformation Dim MyTransformationField As TransformationField Dim MyTransformationDisplay As TransformationDisplay Dim MyDataFlow As DataFlow Dim MyLineageComponent As LineageComponent Dim MyDataStream As DataStream Dim sTransformationName$ #End Region LogIt "Work" DiagramManager.EnableScreenUpdateEx(False, False) DlgEnable("pbStart", False) sLinkName = DlgText "tbLinkName" sPrefix = DlgText "tbPrefix" bUseDomains = DlgValue "cbDomains" bVDL = DlgValue("cbVDL") If bUseDomains Then iDictionarySelect = DlgValue "dictionary_select" If dictionary_list(iDictionarySelect) = "Local" Then Set MyDictionary = MyDiagram.Dictionary Else Set MyDictionary = MyDiagram.EnterpriseDataDictionaries.Item(dictionary_list(iDictionarySelect)) End If End If Dim iX%, iY% Dim edf% Set MyEntityDisplay = MySubModel.EntityDisplays.Item(If(IsLogical, laHub(LBound(laHub)).EntityName, laHub(LBound(laHub)).TableName)) If MyEntityDisplay Is Nothing Then iX = 0 iY = 0 Else iX = MyEntityDisplay.HorizontalPosition + MARGIN iY = MyEntityDisplay.VerticalPosition + MARGIN End If Set theLinkEnt = MyModel.Entities.Add(iX, iY) theLinkEnt.EntityName = LCase(sPrefix & sLinkName) theLinkEnt.TableName = theLinkEnt.EntityName theLinkEnt.Note = "Link – describes a unique list of relationships/interactions between business keys" Set theAttr = theLinkEnt.Attributes.Add(LCase(HASH_KEY_PREFIX & theLinkEnt.EntityName), True) UseDomain(bUseDomains, MyDictionary, DOMAIN_FOLDER, theAttr, HASH_DATATYPE, HASH_DATALENGTH) Dim rLink As Relationship For iLoop = LBound(laHub) To UBound(laHub) Set rLink = MyModel.Relationships.Add(If(IsLogical, laHub(iLoop).EntityName, laHub(iLoop).TableName), theLinkEnt.EntityName, 1) Next iLoop Set theAttr = theLinkEnt.Attributes.Add("dss_record_source", False) UseDomain(bUseDomains, MyDictionary, DOMAIN_FOLDER, theAttr, "VARCHAR", 256) Set theAttr = theLinkEnt.Attributes.Add("dss_load_date", False) UseDomain(bUseDomains, MyDictionary, DOMAIN_FOLDER, theAttr, "DATETIME", 0) Set MyEntityDisplay = MySubModel.EntityDisplays.Item(theLinkEnt.EntityName) MyEntityDisplay.BackgroundColor = LINK_BGCOLOR MyEntityDisplay.NonInheritedPrimaryKeysColor = LINK_FGCOLOR MyEntityDisplay.NonInheritedNonKeysColor = LINK_FGCOLOR MyEntityDisplay.InheritedNonKeysColor = LINK_FGCOLOR MyEntityDisplay.NameColor = If(NAME_COMPARTMENT, LINK_FGCOLOR, LINK_BGCOLOR) MyEntityDisplay.DisplayBackgroundColor = True MyEntityDisplay.HorizontalPosition = iX MyEntityDisplay.VerticalPosition = iY If NAME_COMPARTMENT Then MySubModel.ShowEntityNameCompartment = NAME_COMPARTMENT edf = MySubModel.EntityDisplayFormat If (edf <> 7) And (edf <> 8) Then MySubModel.EntityDisplayFormat = If(IsLogical, 7, 8) End If End If LogIt "New link created: " & theLinkEnt.EntityName #Region "Visual Data Lineage" ' Manage Visual Data Lineage If bVDL Then Set MyDataFlow = MyDiagram.DataFlows.Item(DATA_FLOW_NAME) If MyDataFlow Is Nothing Then 'data flow doesn't exist so create it Set MyDataFlow = MyDiagram.DataFlows.Add(DATA_FLOW_NAME) End If If MyDataFlow Is Nothing Then 'if the object is still not initialized something happened when creating it. log error to log file LogIt "Data Flow <" & DATA_FLOW_NAME & "> could not be created." LogIt DiagramManager.GetLastErrorString Else ' Add Tranformation for the HashKey sTransformationName = TRANSFORMATION_NAME & " " & theLinkEnt.EntityName 'after the data flow is created, create the transformation Set MyTransformationDisplay = MyDataFlow.TransformationDisplays.Item(sTransformationName) Set MyTransformation = MyDataFlow.Transformations.Item(sTransformationName) If MyTransformation Is Nothing And MyTransformationDisplay Is Nothing Then 'if neither the display or object exist add it to the data flow Set MyTransformation = MyDataFlow.Transformations.Add(300, 600) If MyTransformation Is Nothing Then 'log missing transformation in the error string LogIt "Transformation <" & sTransformationName & "> could not be created." LogIt DiagramManager.GetLastErrorString Else 'set the name and display object MyTransformation.Name = sTransformationName Set MyTransformationDisplay = MyDataFlow.TransformationDisplays.Item(sTransformationName) 'set the other transformation properties MyTransformation.Type = "Direct Map" MyTransformation.BusinessDefinition = "HashKeys from the Hubs" MyTransformation.CodeDefinition = "" ' Add the sources For iLoop = LBound(laHub) To UBound(laHub) 'see if the lineage component exists in the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.ItemBySource(1, laHub(iLoop).ID) If MyLineageComponent Is Nothing Then ' Add the object to the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.Add(1, laHub(iLoop).ID, 650, (400 + (200 * iLoop))) End If ' Add data stream between source & transformation Set MyDataStream = MyDataFlow.DataStreams.Add(MyTransformation.Name, MyLineageComponent.ID, True) If MyDataStream Is Nothing And Not(MyLineageComponent Is Nothing) Then 'log to error file LogIt "Data Stream between <" & MyLineageComponent.Name & "> and <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'now add the input columns For Each theAttr In laHub(iLoop).Attributes ' get the hashkey If theAttr.PrimaryKey And (InStr(LCase(theAttr.AttributeName), LCase(HASH_KEY_PREFIX)) = 1) Then 'set input column based on attribute Set MyTransformationField = MyTransformation.LineageInputs.Add(5, theAttr.ID) If MyTransformationField Is Nothing Then 'log to error file LogIt "Transformation Output <" & LCase(HASH_KEY_PREFIX & laHub(iLoop).EntityName) & "> between Lineage Component <" & MyLineageComponent.Name & "> and Transformation <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString End If ' HK found, exit the loop Exit For End If Next theAttr End If ' data stream ' Set rLink = MyModel.Relationships.Add(If(IsLogical, laHub(iLoop).EntityName, laHub(iLoop).TableName), theLinkEnt.EntityName, 1) Next iLoop ' Add the target 'see if the lineage component exists in the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.ItemBySource(1, theLinkEnt.ID) If MyLineageComponent Is Nothing Then ' Add the object to the data flow Set MyLineageComponent = MyDataFlow.LineageComponents.Add(1, theLinkEnt.ID, 650, 600) End If ' Add data stream between source & transformation Set MyDataStream = MyDataFlow.DataStreams.Add(MyTransformation.Name, MyLineageComponent.ID, False) If MyDataStream Is Nothing And Not(MyLineageComponent Is Nothing) Then 'log to error file LogIt "Data Stream between <" & MyLineageComponent.Name & "> and <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString Else 'now add the output columns For Each theAttr In theLinkEnt.Attributes ' get the hashkey If theAttr.ForeignKey And (InStr(LCase(theAttr.AttributeName), LCase(HASH_KEY_PREFIX)) = 1) Then 'set output column based on attribute Set MyTransformationField = MyTransformation.LineageOutputs.Add(5, theAttr.ID) If MyTransformationField Is Nothing Then 'log to error file LogIt "Transformation Output <" & LCase(HASH_KEY_PREFIX & theLinkEnt.EntityName) & "> between Lineage Component <" & MyLineageComponent.Name & "> and Transformation <" & MyTransformation.Name & "> could not be added in data flow <" & MyDataFlow.Name & ">." LogIt DiagramManager.GetLastErrorString End If End If Next theAttr End If ' data stream End If ' tran is nothing End If 'tran and tran display check End If 'data flow existence check End If ' Visual Data Lineage #End Region ' Job finished MySubModel.ActivateSubModel For iLoop = LBound(laHub) To UBound(laHub) MySubModel.SelectedObjects.Add(1, laHub(iLoop).ID) Next DiagramManager.EnableScreenUpdateEx(True, True) DlgText("pbStart", "Completed") End Sub Sub Main On Error GoTo errHandler Dim sName$ InitCommonVars(aLog, MyDiagram, MyModel, MySubModel, IsLogical, sParentName, sChildName) sParentsName = If(IsLogical, "Entities", "Tables") If MySubModel.SelectedObjects.Count < 2 Then MsgBox "Error:" & vbCrLf & vbCrLf & "You must select at least 2 hubs!", vbExclamation, TITLE Exit Sub End If ReDim laHub(0 To MySubModel.SelectedObjects.Count - 1) ReDim laHubName(0 To MySubModel.SelectedObjects.Count - 1) iLoop = 0 For Each MySelectedObject In MySubModel.SelectedObjects If (MySelectedObject.Type <> 1) Then MsgBox "Error:" & vbCrLf & vbCrLf & "You can only select " & sParentsName & "!", vbExclamation, TITLE Exit Sub End If Set laHub(iLoop) = MyModel.Entities.Item(MySelectedObject.ID) laHubName(iLoop) = If(IsLogical, laHub(iLoop).EntityName, laHub(iLoop).TableName) ' If (LCase(Left(If(IsLogical, laHub(iLoop).EntityName, laHub(iLoop).TableName), 2)) <> LCase(HUB_PREFIX)) Then ' MsgBox "Error:" & vbCrLf & vbCrLf & "You can only select hubs!", vbExclamation, TITLE ' Exit Sub ' End If ' Debug.Print "Selected Hub: " & If(IsLogical, laHub(iLoop).EntityName, laHub(iLoop).TableName) iLoop = iLoop + 1 Next MySelectedObject Begin Dialog UserDialog 770,420,TITLE,.DialogFunc ' %GRID:10,7,1,1 Text 30,7,110,14,"Link Name:",.linkCaption,1 TextBox 160,5,600,18,.tbLinkName Text 30,28,110,14,"Prefix:",.prefixCaption,1 TextBox 160,26,600,18,.tbPrefix GroupBox 10,49,750,119,"Selected hubs",.gbAttributes MultiListBox 20,63,730,98,laHubName(),.mlbAttributes,3 CheckBox 20,175,730,14,"Domains for common Data Vault attributes/columns",.cbDomains Text 20,196,120,14,"Select Dictionary: ",.tDictionary,1 DropListBox 160,193,590,112,dictionary_list(),.dictionary_select CheckBox 20,217,730,14,"Generate Visual Data Lineage",.cbVDL PushButton 350,238,90,21,"Start",.pbStart ListBox 20,266,740,112,aLog(),.lbLog,1 PushButton 20,392,90,21,"Blog post",.pbBlog PushButton 350,392,90,21,"Close",.cbCancel CancelButton 355,695,80,15 ' out of screen: allow to close the dialog with the X End Dialog Dim dlg As UserDialog sName = "" For iLoop = 0 To UBound(laHubName) sName = sName & "_" & Right(laHubName(iLoop), Len(laHubName(iLoop)) - 2) Next iLoop sName = Right(sName, Len(sName) - 1) init_dictionary_list(dictionary_list, MyDiagram, MyDictionary) dlg.tbLinkName = LCase(sName) dlg.tbPrefix = "l_" dlg.cbDomains = True dlg.cbVDL = True dlg.dictionary_select = UBound(dictionary_list) 'Default DD = Latest one: if only one, it's the local one, otherwise, an EDD Dialog dlg Exit Sub errHandler: ManageError(Err, TITLE, TIMESTAMPED) End Sub Private Function DialogFunc(DlgItem$, Action%, SuppValue&) As Boolean Dim i%, iLoop%, s%() Select Case Action% Case 1 ' Dialog box initialization InitDialog("tbLinkName", MyDiagram, MyModel, MySubModel, aLog, TIMESTAMPED) DlgEnable("mlbAttributes", False) Case 2 ' Value changing or button pressed DialogFunc = DialogControlUpdated("tbLinkName", DlgItem) If DlgItem = "pbStart" Then Work End If Case 3 ' TextBox or ComboBox text changed RefreshButtonStart("tbLinkName") End Select End Function Private Sub LogIt(ByVal txt As String) Log(txt, aLog, TIMESTAMPED) End Sub
_wDataVault.bas.hidden
_wDataVault.bas.hidden
'#Language "WWB-COM" ''MACRO TITLE: _wDataVault ' MACRO VERSION: 1.1 'This macro is used by others: DO NOT DIRECTLY RUN IT! ' - wHub ' - wLink ' - wSatellite ' ' Release notes ' 1.1: Domains folders updated ' 1.0 Initial version '--------------------------------------------------------------------------- Option Explicit Const DOMAIN_FOLDER$ = "Data Vault" ' Root folder for the domains Sub main Debug.Print "You need to run another macro." MsgBox "You need to run another macro:" & vbCrLf & vbCrLf & "- wHub" & vbCrLf & "- wSatellite" & vbCrLf & "- wLink", vbCritical End Sub Public Sub InitCommonVars(ByRef aLog$(), ByRef MyDiagram As Diagram, ByRef MyModel As Model, ByRef MySubModel As SubModel, ByRef IsLogical As Boolean, ByRef sParentName$, ByRef sChildName$) Debug.Clear ReDim aLog(0) 'Get the current diagram. Set MyDiagram = DiagramManager.ActiveDiagram 'Get the current model. Set MyModel = MyDiagram.ActiveModel IsLogical = MyModel.Logical sParentName = If(IsLogical, "Entity", "Table") sChildName = If(IsLogical, "Attribute", "Column") 'Get the current submodel. Set MySubModel = MyModel.ActiveSubModel End Sub 'initialize the dictionary drop down list Public Sub init_dictionary_list(ByRef dictionary_list$(), MyDiagram As Diagram, MyDictionary As Dictionary) 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 End Sub Public Sub InitDialog(sName$, ByVal MyDiagram As Diagram, ByVal MyModel As Model, ByVal MySubModel As SubModel, ByRef aLog$(), bTS As Boolean) DlgEnable("pbStart", False) Log("Project: " & MyDiagram.ProjectName, aLog, bTS) Log("Filename: " & MyDiagram.FileName, aLog, bTS) Log("Model: " & MyModel.Name, aLog, bTS) Log("Submodel: " & MySubModel.Name, aLog, bTS) RefreshButtonStart(sName) End Sub Public Function DialogControlUpdated(sName$, DlgItem$) DialogControlUpdated = True DlgEnable("pbStart", False) If DlgItem = "cbDomains" Then DlgEnable("tDictionary", DlgValue("cbDomains")) DlgEnable("dictionary_select", DlgValue("cbDomains")) ElseIf DlgItem = "pbBlog" Then ShowBlogPost ElseIf DlgItem = "cbCancel" Then DialogControlUpdated = False End If RefreshButtonStart(sName) End Function Public Function RefreshButtonStart(sName$) Dim bEnable As Boolean bEnable = (sName = "tbLinkName") ' No attributes|columns to check for the Link If Not bEnable Then Dim s%() s = DlgValue "mlbAttributes" bEnable = LBound(s) <= UBound(s) End If bEnable = bEnable And ((DlgText sName) <> "") bEnable = bEnable And ((DlgText "tbPrefix") <> "") DlgEnable("pbStart", bEnable) RefreshButtonStart = bEnable End Function Private Function GetDomain(MyDictionary As Dictionary, sDomainFolder$, sDomain$) As Domain Dim MyDomain As Domain Dim MyDomainFolder As DomainFolder Set GetDomain = MyDictionary.Domains(sDomain) If GetDomain Is Nothing Then ' Check if Domain Folder exists: if not, create it Set MyDomainFolder = MyDictionary.DomainFolders.Item(sDomainFolder) If MyDomainFolder Is Nothing Then ' Check if Parent folder exists Set MyDomainFolder = MyDictionary.DomainFolders.Item(DOMAIN_FOLDER) If MyDomainFolder Is Nothing Then ' Create Parent folder MyDictionary.DomainFolders.Add(DOMAIN_FOLDER, "") End If ' Create the folder Set MyDomainFolder = MyDictionary.DomainFolders.Add(sDomainFolder, DOMAIN_FOLDER) End If ' Create the domain Set GetDomain = MyDictionary.Domains.AddEx(sDomain, sDomain, sDomain, MyDomainFolder.ID) End If End Function Public Sub UseDomain(bUseDomains As Boolean, MyDictionary As Dictionary, sDomainFolder$, theAttr As AttributeObj, sDatatype$, iDataLength%) Dim MyDomain As Domain If bUseDomains Then Set MyDomain = GetDomain(MyDictionary, sDomainFolder, theAttr.AttributeName) MyDomain.Datatype = sDatatype MyDomain.DataLength = iDataLength MyDomain.Nullable = False theAttr.DomainId = MyDomain.ID Else theAttr.Datatype = sDatatype theAttr.DataLength = iDataLength theAttr.NullOption = "NOT NULL" End If End Sub Public Function PrefixDT(txt As String, bTS As Boolean) As String If bTS Then PrefixDT = CStr(Now) & Chr(9) & txt Else PrefixDT = txt End If End Function Public Sub Log(ByVal txt As String, ByRef aLog$(), ByVal bTS As Boolean) Dim idx As Integer idx = UBound(aLog) + 1 ReDim Preserve aLog(idx) aLog(idx) = PrefixDT(txt, bTS) Debug.Print PrefixDT(txt, bTS) DlgListBoxArray("lbLog", aLog) DlgValue("lbLog", idx) ' Scroll to the last row DlgValue("lbLog", -1) ' Unselect all rows End Sub Public Sub ShowBlogPost Shell "explorer https://blog.idera.com/database-tools/data-vault-modeling-with-er-studio-data-architect/", vbNormalFocus 'explorer to open with the default browser End Sub Public Sub ManageError(e As ErrObject, sTITLE$, bTS As Boolean) If Err.Number = 10031 Then ' Form is closing Debug.Print PrefixDT("Closing", bTS) Else MsgBox "Error:" & vbCrLf & vbCrLf & Err.Description, vbExclamation, sTITLE End If DiagramManager.EnableScreenUpdateEx(True, True) End Sub
Here you go. You have the 5 macros shared above and you can edit and use them as much as you need.