Macro: Data Lineage export to tab delimited file

Attached is a modified macro to the "Data Lineage Export to Excel" macro packaged with ER/Studio.  This will run significantly faster than the one to Excel since it won't be writing to a cell but just to a plain text.  You can import this into Excel and then run the "Data Lineage Import from Excel" to import it back into ER/Studio.

 

Things to note: 

  • Consecutive tabs must be imported as new cells
  • Tabs/new line characters in transformation logic/descriptions may not be exported properly so these are removed and replaced with spaces.  If you need those, then make sure you add them back in after importing it into Excel.

 

0211.Data Lineage Export to tab delimited file.txt
'MACRO TITLE: DATA LINEAGE EXPORT TO tab delimited file.BAS
' This macro will output the data lineage information to a tab delimited file.
' This output will work with the Data Lineage Import macro but first needs to
' be imported to Excel.  Consecutive tabs must be treated as new columns
' NOTE: New lines (in descriptions and/or logic) are removed and place in one
'		line.  If this needs to be changed, it must be changed after importing
'		into Excel.

'CREATE DATE:  6/7/2006
'LAST UPDATE:  7/13/2017
'VERSION:  1.0

'Const FILENAME = "C:\temp\test.csv"

Dim FILENAME As String

' dim dialog variables
Dim selected_object_loop As Boolean    'if true, macro loops through selected objects
									   'if false, macro loops through all objects

Type OptionSet
	chbx As Boolean
	startnum As Integer
End Type


Dim ExportOptions (0 To 3) As OptionSet

' Dim ER/Studio variables.
	
Dim diag As Diagram
Dim mdl As Model
Dim submdl As SubModel
Dim so As SelectedObject
Dim ent As Entity
Dim attr As AttributeObj
Dim rel As Relationship
Dim entdisplay As EntityDisplay
Dim dmcl As DataMovementColumnLink
Dim dmml As DataMovementModelLink

Sub Main
	Dim starttime, elapsedtime



	' Init the ER/Studio variables.
	
	Set diag = DiagramManager.ActiveDiagram
	Set mdl = diag.ActiveModel
	Set submdl = mdl.ActiveSubModel
	DiagramManager.EnableScreenUpdateEx False, True

	Debug.Clear

	' Prompt the user.
	
	Begin Dialog UserDialog 690,343,"Data Lineage Export Options",.ExportHandler ' %GRID:10,7,1,1
		Text 20,7,150,14,"Diagram Information:",.diaginfotxt
		GroupBox 330,119,340,91,"Choose Export Scope",.GroupBox3
		OptionGroup .object_sel
			OptionButton 360,147,130,14,"All Objects",.OptionButton3
			OptionButton 360,175,140,14,"Selected Objects",.OptionButton4
		OKButton 40,287,160,35,.OK
		CancelButton 250,287,150,35
		TextBox 20,28,650,70,.diag_info,1
		GroupBox 20,119,290,147,"Choose Mappings to Export",.GroupBox1
		CheckBox 50,147,240,21,"Direct Source Mappings",.directsrc_chbx
		CheckBox 50,175,230,21,"Secondary Source Mappings",.Secondsrc_chbx
		CheckBox 50,203,230,14,"Direct Target Mappings",.directtrgt_chbx
		CheckBox 50,231,210,14,"Secondary Target Mappings",.Secondtrgt_chbx
		Text 340,217,120,14,"Choose Filepath ",.Text1
		TextBox 340,238,230,21,.FilePathBox
		PushButton 590,238,80,21,"Browse",.Browse
	End Dialog
	Dim dlg As UserDialog


starttime = Timer
	'initialize the dialog info text block.
	Dim sel_objects As String
	Dim mdl_type As String

	If entitiesSelected = False Then
		sel_objects = "NO"
	Else
		sel_objects = "YES"
	End If

	If mdl.Logical = True Then
		mdl_type = "LOGICAL"
	Else
		mdl_type = "PHYSICAL"
	End If

	'populate text box in the dialog with some information about what will be exported
	dlg.diag_info = "Diagram:  " & diag.ProjectName & vbCrLf & "Model Name:  " & mdl.Name & vbCrLf & "Model Type:  " & mdl_type & vbCrLf & "Active Model:  " & submdl.Name & vbCrLf & "Selected Objects:  " & sel_objects



	clrBack = CLR_WHITE
	clrFore = CLR_BLACK
	clrTitleBack = CLR_GREY
	clrTitleFore = CLR_BLACK

	
	' Print the spread sheet.
Debug.Print "chbx"
	If Dialog(dlg) = -1 Then
Debug.Print "chbx2"
		'initialize dialog option array
		ExportOptions(0).chbx = dlg.directsrc_chbx
		ExportOptions(1).chbx = dlg.secondsrc_chbx
		ExportOptions(2).chbx = dlg.directtrgt_chbx
		ExportOptions(3).chbx = dlg.Secondtrgt_chbx


		ExportOptions(0).startnum = 8
		ExportOptions(1).startnum = 8
		ExportOptions(2).startnum = 8
		ExportOptions(3).startnum = 8

		If ExportOptions(0).chbx Then
			ExportOptions(1).startnum = ExportOptions(0).startnum + 4
			ExportOptions(2).startnum = ExportOptions(0).startnum + 4
			ExportOptions(3).startnum = ExportOptions(0).startnum + 4
		End If

		If ExportOptions(1).chbx Then
			ExportOptions(2).startnum = ExportOptions(1).startnum + 4
			ExportOptions(3).startnum = ExportOptions(1).startnum + 4
		End If

		If ExportOptions(2).chbx Then
			ExportOptions(3).startnum = ExportOptions(2).startnum + 4
		End If

		Debug.Print ExportOptions(0).chbx & " " & ExportOptions(1).chbx & " " & ExportOptions(2).chbx & " " & ExportOptions(3).chbx & " "
		Debug.Print ExportOptions(0).startnum & " " & ExportOptions(1).startnum & " " & ExportOptions(2).startnum & " " & ExportOptions(3).startnum & " "

		Open dlg.FilePathBox For Output As #1

		'Open FILENAME For Output As #1

	    PrintColumnHeader
	    
	    PrintData


	Debug.Print Timer - starttime
		MsgBox("Data Lineage export complete.",vbOkOnly)


	End If 'dialog
DiagramManager.EnableScreenUpdateEx True, True


End Sub

Sub PrintData


	If selected_object_loop = False Then

		'loop through all objects in the model
		For Each entdisplay In submdl.EntityDisplays

			Set ent = entdisplay.ParentEntity

			For j = 1 To ent.Attributes.Count
		
				For Each attr In ent.Attributes
			
						If attr.SequenceNumber = j Then
				
								udfPrintAttributeInfo ()

								udfPrintAttributeDataLineage(attr, ExportOptions())

						End If  'sequence number check

					Next attr
	
				Next j

		Next entdisplay

	Else

	    'Only report on selected entities
		For Each so In submdl.SelectedObjects
	
			If so.Type = 1 Then
	
			Set ent = mdl.Entities.Item(so.ID)
	
				For j = 1 To ent.Attributes.Count
		
					For Each attr In ent.Attributes
			
						If attr.SequenceNumber = j Then
				

								udfPrintAttributeInfo ()

								udfPrintAttributeDataLineage(attr, ExportOptions())


						End If  'sequence number check

					Next attr

				Next j


	        End If 'so ID check
	
		Next so

	End If ' selected object check



End Sub

Function udfPrintAttributeInfo ()

		Print #1, mdl.Name; vbTab ; ent.TableName; vbTab ; attr.ColumnName; vbTab ; udfDatatype(attr); vbTab; udfIsNull(attr); vbTab; udfIsPrimary(attr); vbTab;

End Function

Function udfIsNull ( currAttr As AttributeObj ) As String

	If currAttr.NullOption = "NULL" Then

		udfIsNull = "Y"

	Else

		udfIsNull = "N"

	End If

End Function

Function udfIsPrimary ( currAttr As AttributeObj ) As String

	If currAttr.PrimaryKey Then

		udfIsPrimary = "Y"

	Else

		udfIsPrimary = "N"

	End If

End Function

Function udfDatatype ( currAttr As AttributeObj ) As String
	
	Dim dt As String

	dt = Replace(currAttr.CompositeDatatype, " NULL", "")
	dt = Replace(dt, " NOT", "")

	udfDatatype =  dt

End Function


Function udfPrintAttributeDataLineage ( currAttr As AttributeObj, LineageOptions As Variant)

	If LineageOptions(0).chbx Or LineageOptions(1).chbx Or LineageOptions(2).chbx Or LineageOptions(3).chbx Then

		Dim ds_column_str As String

		Dim ss_column_str As String

		Dim dt_column_str As String

		Dim st_column_str As String


		For Each dmcl In currAttr.DataMovementColumnLinks
		
			If dmcl.IsDirectSource = True  Then
			'Direct Source Mappings
	
				ds_column_str = ds_column_str & dmcl.SrcTrgtModelName & "." & dmcl.SrcTrgtTableName & "." & dmcl.SrcTrgtColumnName
				ds_column_str = ds_column_str & ",  "

			End If
	
			If dmcl.IsSecondarySource = True Then
			'Secondary Source Mappings
	
				ss_column_str = ss_column_str & dmcl.SrcTrgtModelName & "." & dmcl.SrcTrgtTableName & "." & dmcl.SrcTrgtColumnName
				ss_column_str = ss_column_str & ",  "

			End If

			If dmcl.IsDirectTarget = True Then
			'Direct Target Mappings

				dt_column_str = dt_column_str & dmcl.SrcTrgtModelName & "." & dmcl.SrcTrgtTableName & "." & dmcl.SrcTrgtColumnName
				dt_column_str = dt_column_str & ",  "

			End If

            If dmcl.IsSecondaryTarget = True Then
			'Secondary Target Mappings

				st_column_str = st_column_str & dmcl.SrcTrgtModelName & "." & dmcl.SrcTrgtTableName & "." & dmcl.SrcTrgtColumnName
				st_column_str = st_column_str & ",  "
	
			End If
	
		Next

		'remove last comma
		If Len(ds_column_str) <> 0 Then
			ds_column_str = Left(ds_column_str, Len(ds_column_str)-3)
		End If

		If Len(ss_column_str) <> 0 Then
			ss_column_str = Left(ss_column_str, Len(ss_column_str)-3)
		End If

		If Len(dt_column_str) <> 0 Then
			dt_column_str = Left(dt_column_str, Len(dt_column_str)-3)
		End If

		If Len(st_column_str) <> 0 Then
			st_column_str = Left(st_column_str, Len(st_column_str)-3)
		End If

		If LineageOptions(0).chbx Then
			Print #1, vbTab; ds_column_str ;
			Print #1, vbTab; Replace(currAttr.SourceDirectTransformationLogic, vbCrLf, " ");
			Print #1, vbTab; Replace(currAttr.SourceDirectTransformationDescription, vbCrLf," ");

		End If

		If LineageOptions(1).chbx Then
			Print #1, vbTab; ss_column_str ;
			Print #1, vbTab; Replace(currAttr.SourceSecondaryTransformationLogic, vbCrLf, " ");
			Print #1, vbTab; Replace(currAttr.SourceSecondaryTransformationDescription, vbCrLf, " ");

		End If

		If LineageOptions(2).chbx Then
			Print #1, vbTab; dt_column_str ;
			Print #1, vbTab; Replace(currAttr.TargetDirectTransformationLogic, vbCrLf, " ");
			Print #1, vbTab; Replace(currAttr.TargetDirectTransformationDescription, vbCrLf, " ");

		End If

		If LineageOptions(3).chbx Then
			Print #1, vbTab; st_column_str ;
			Print #1, vbTab; Replace(currAttr.TargetSecondaryTransformationLogic, vbCrLf, " ");
			Print #1, vbTab; Replace(currAttr.TargetSecondaryTransformationDescription, vbCrLf, " ");

		End If

	End If
Print #1, ""

End Function



' Print the column header.  Only print headers when value is true in options array.

Sub PrintColumnHeader()
	Print #1
	Print #1
	Print #1,"Physical Model Information - Model Name" & vbTab & "Table Name" & vbTab & "Column Name" & vbTab & "DataType" & vbTab & "Null?" & vbTab & "Primary?" & vbTab;
	If ExportOptions(0).chbx Then
		Print #1, vbTab & "Direct Source Mappings - Direct Source(s)" & vbTab & "Direct Source Logic" & vbTab & "Direct Source Description";
	End If
	If ExportOptions(1).chbx Then
		Print #1, vbTab & "Secondary Source Mappings - Secondary Source(s)" & vbTab & "Secondary SourceSecondary Source Logic" & vbTab & "Secondary Source Description";
	End If
If ExportOptions(2).chbx Then
		Print #1, vbTab & "Direct Target Mappings - Direct Target(s)" & vbTab & "Direct Target Logic" & vbTab & "Direct Target Description";
	End If
	If ExportOptions(3).chbx Then
		Print #1, vbTab & "Secondary Target Mappings - Secondary Target(s)" & vbTab & "Secondary Target Logic" & vbTab & "Secondary Target Description";
	End If
	Print #1, ""
End Sub

Function entitiesSelected() As Boolean

	Dim selObj As SelectedObject
	
	If submdl.SelectedObjects.Count > 0 Then
		For Each selObj In submdl.SelectedObjects
			If selObj.Type=1 Then
				entitiesSelected = True
				Exit Function
			End If
		Next
	End If

	entitiesSelected = False

End Function

Rem See DialogFunc help topic for more information.
Private Function ExportHandler(DlgItem$, Action%, SuppValue&) As Boolean
	Select Case Action%
	Case 1 ' Dialog box initialization



			If entitiesSelected = False Then

				DlgEnable "OptionButton4", False
				selected_object_loop = False
			
			Else
				
				DlgEnable "optionbutton4", True
				DlgValue "object_sel", 1
				selected_object_loop = True

			End If

	Case 2 ' Value changing or button pressed

		If DlgItem = "object_sel" Then

			selected_object_loop = DlgValue("object_sel")

			Debug.Print DlgValue("object_sel")
			Debug.Print "selected_object_loop = " & selected_object_loop

		End If
		If DlgItem ="Browse" Then

			DlgText "FilePathBox", GetFilePath(,"txt",,"Open text file",1)

			ExportHandler = True 'do not exit the dialog
		End If


		If DlgItem = "OK" And DlgText("FilePathBox") = "" Then
			'don't exit dialog if a path is not specified
			MsgBox("Please enter a valid path.",,"Error!")
			ExportHandler = True
		End If

		Rem ExportHandler = True ' Prevent button press from closing the dialog box
	Case 3 ' TextBox or ComboBox text changed
	Case 4 ' Focus changed
	Case 5 ' Idle
		Rem ExportHandler = True ' Continue getting idle actions
	Case 6 ' Function key
	End Select
End Function