Macros – Sample macros to import Logical and Physical Data Models from Microsoft Visio to ER/Studio Data Architect

by William W.Jul 27, 2023

Introduction

With dozens of ready-to-use templates and thousands of customizable shapes, Visio makes it easy —and fun— to create powerful visuals.

So with Visio we can draw charts, plans and diagrams.

Some people have used Visio to create their Logical and/or Physical Data Models and they would like to import their drawings in a data architecture and design tool: ER/Studio Data Architect.

The issue with Visio Drawings is that you can draw your Entities, Attributes, Relationships, by using different shapes as there’s a vast library of shapes, stencils, and templates.
Moreover, even if everyone is using the same objects, you can connect your relationships in many different ways: between 2 attributes, between 2 entities, in fact, between any 2 Connection Points. So, it would be really difficult to create a generic macro which works for everybody.

However, in this blog post, I’ll share 2 scripts which can import Entities & Attributes from a Visio Drawing page. I have tested the macros with 2 different samples:

Bugs ER Diagram
Books ER Diagram

Visio Drawing Samples

System requirements

To run the macros below, you’d need:

ER/Studio Data Architect
Microsoft Visio installed on the same machine (not the Cloud remote version)

Scripts

The 2 scripts are using a Reference to the Visio Library Type. You need to add this Reference to your macro.
To do so, from the Macro Editor, right-click in the Code Window and select the menu item: Edit/References…

Add References

The References dialog shows the current macro/module/project’s references. You need to add the Visio Type Library:

Visio Type Library

Once, it’s done, you can copy/paste the code below in your Macro Editor:

'#Language "WWB-COM"
''MACRO TITLE: Import Entities & Attributes from Visio
' MACRO VERSION: 1.0
'
'This macro imports Entities and Attributes from a Visio Drawing
'
' Requirements:
'	Visio needs to be installed on the same machine
'	Macro needs to reference: Microsoft Visio 16.0 Type Library
'	(right-click: Edit / References... ; check the reference above)
'
' Known limitations:
'	It doesn't import the relationships
'---------------------------------------------------------------------

Option Explicit

Const VISIO_DRAWING_FILE$ = "<YOUR_PATH><FILENAME>\LDM.vsdx" ' Path to your Visio Drawing
Const TITLE$ = "Import Entities & Attributes from Visio"
Const RATIO_POSITION& = 25 ' Ratio between position in Visio Page & ER/Studio Diagram

' Depending on the shapes you are using, you may have to edit these constants
Const SHAPE_CATEGORIES = "User.msvShapeCategories"
Const CATEGORY_ENTITY$ = "DbEntity"
Const CATEGORY_ATTRIBUTE$ = "DbAttribute"
Const PRIMARY_KEY$ = "PrimaryKey"
Const FOREIGN_KEY$ = "ForeignKey"
Const NULL_OPTION$ = "Required"

Sub Main

	' Visio
	Dim vsoApplication As Visio.Application 
	Dim vsoDocument As Visio.Document
	Dim vsoPage As Visio.Page
	Dim vsoShape As Visio.Shape
	Dim vsoAShape As Visio.Shape

	Dim lMemberID&, alShapeIDs&(), lLoop&
	Dim lLocationX&, lLocationY&
	Dim sDateSaved$
	Dim lContainerID&, lNbImportedEntities&

	' ER/Studio
	Dim MyDiagram As Diagram
	Dim MyModel As Model
	Dim MySubModel As SubModel
	Dim MyEntity As Entity
	Dim MyAttribute As AttributeObj

	Debug.Clear
	lNbImportedEntities = 0

	' Open Visio
	Set vsoApplication = CreateObject("Visio.Application")
	' Open the Visio Drawing
	Set vsoDocument = vsoApplication.Documents.OpenEx VISIO_DRAWING_FILE, visOpenRO
	' Get the first page
	Set vsoPage = vsoApplication.ActiveDocument.Pages(1)

	' Create a new diagram.
	Set MyDiagram = DiagramManager.NewDiagram

	' A new diagram will automatically have a logical model - which is also the currently, active model.
	Set MyModel = MyDiagram.ActiveModel

	' Get the Main Model
	Set MySubModel = MyModel.ActiveSubModel
	MySubModel.ShowEntityNullOption = True

	' Document properties
	Debug.Print vsoDocument.FullName
	MyDiagram.Description = "Entities & Attributes imported from " & vsoDocument.FullName
	MyDiagram.ProjectName = vsoDocument.Title
	MyDiagram.Author = vsoDocument.Creator
	MyDiagram.Company = vsoDocument.Company
	MyDiagram.CopyrightYear = Format(vsoDocument.TimeSaved, "yyyy")

	' Loop on all Containers: Entities should be containers
	For Each lContainerID In vsoPage.GetContainers(visContainerExcludeNested)
		
		Set vsoShape = vsoPage.Shapes.ItemFromID(lContainerID)

		If HasCategory(vsoShape, CATEGORY_ENTITY) Then

			Debug.Print ""

			'Get location Shape
			GetShapePosition(vsoShape, lLocationX, lLocationY)

			Debug.Print "Entity: " & vsoShape.Text & " [" & vsoShape.Name & " - " & vsoShape.Cells(SHAPE_CATEGORIES).Formula() & "]" & " (" & lLocationX & ", " & lLocationY & ")"

			' Add the entity to the model.
			Set MyEntity = MyModel.Entities.Add(lLocationX * RATIO_POSITION, - lLocationY * RATIO_POSITION)
			MyEntity.EntityName = vsoShape.Text
			lNbImportedEntities = lNbImportedEntities + 1

			For Each lMemberID In vsoShape.ContainerProperties.GetMemberShapes(visContainerFlagsExcludeCallouts + visContainerFlagsExcludeContainers + visContainerFlagsExcludeConnectors + visContainerFlagsExcludeNested)

				Set vsoAShape = vsoPage.Shapes.ItemFromID(lMemberID)

				If HasCategory(vsoAShape, CATEGORY_ATTRIBUTE) Then

					Debug.Print "Attribute: " & vsoAShape.Text & " [" & vsoAShape.Name & " - " & vsoAShape.Cells(SHAPE_CATEGORIES).Formula() & "]"

					' Add the attribute to the current entity
					Debug.Print "is PK: " & GetUserDefinedCellValue(vsoAShape, PRIMARY_KEY)
					Set MyAttribute = MyEntity.Attributes.Add(vsoAShape.Text, CBool(GetUserDefinedCellValue(vsoAShape, PRIMARY_KEY)))

					Debug.Print "is FK: " & GetUserDefinedCellValue(vsoAShape, FOREIGN_KEY)

					Debug.Print "is Not Null: " & GetUserDefinedCellValue(vsoAShape, NULL_OPTION)
					If CBool(GetUserDefinedCellValue(vsoAShape, NULL_OPTION)) Then
						
						MyAttribute.NullOption = "NOT NULL"

					Else
						
						MyAttribute.NullOption = "NULL"

					End If

				End If

			Next

			' Log the related objects to the current Entity
			alShapeIDs = vsoShape.ConnectedShapes(visConnectedShapesAllNodes, "")

			For lLoop = 0 To UBound(alShapeIDs)

				Set vsoAShape = vsoPage.Shapes.ItemFromID(alShapeIDs(lLoop))
				Debug.Print "Related objects: " & vsoAShape.Name & ": " & vsoAShape.Text

			Next

		Else
			
			Debug.Print "Ignored object in main loop: " & vsoShape.Type & "(" & vsoShape.Name & "): " & vsoShape.Text

		End If

	Next

	' Exit Visio
	vsoApplication.Quit

	MsgBox "Import completed." & vbCrLf & "(" & lNbImportedEntities & " entit" & IIf(lNbImportedEntities > 1, "ies", "y") & " created)", vbInformation, TITLE

End Sub

Private Sub GetShapePosition(ByVal vsoShape As Visio.Shape, ByRef lLocationX&, ByRef lLocationY&)

	Dim celObj As Visio.Cell

	'Get location Shape
	' X
	Set celObj = vsoShape.Cells("PinX")

	If Not celObj Is Nothing Then
	
		lLocationX = celObj.Result("cm")

	Else
		
		lLocationX = 0

	End If

	' Y
	Set celObj = vsoShape.Cells("PinY")

	If Not celObj Is Nothing Then
	
		lLocationY = celObj.Result("cm")

	Else
		
		lLocationY = 0

	End If

End Sub

Private Function HasCategory(vsoShape As Visio.Shape, sCategory$) As Boolean

	Dim vsoCell As Visio.Cell

	If vsoShape.CellExists(SHAPE_CATEGORIES, False) Then

		Set vsoCell = vsoShape.Cells(SHAPE_CATEGORIES)
	
		HasCategory = InStr(";" & Mid(vsoCell.Formula, 2, Len(vsoCell.Formula) - 2) & ";", ";" & sCategory & ";") > 0

	Else
		
		HasCategory = False

	End If

End Function

Private Function GetUserDefinedCellValue(vsoShape As Visio.Shape, sKey$) As String
	
	Dim vsoCell As Visio.Cell

	If vsoShape.CellExists("User." & sKey, False) Then

		Set vsoCell = vsoShape.Cells("User." & sKey)

		GetUserDefinedCellValue = vsoCell.Formula

	Else
		
		GetUserDefinedCellValue = ""

	End If

End Function

If you don’t know how to proceed, this short video shows how to create a macro from a script in ER/Studio Data Architect:

A second script which adds a User Dialog shown when the macro runs:

User dialog

'#Language "WWB-COM"
''MACRO TITLE: Import Entities & Attributes from Visio
' MACRO VERSION: 1.0
'
'This macro imports Entities and Attributes from a Visio Drawing
'
' Requirements:
'	Visio needs to be installed on the same machine
'	Macro needs to reference: Microsoft Visio 16.0 Type Library
'	(right-click: Edit / References... ; check the reference above)
'
' Known limitations:
'	It doesn't import the relationships
'---------------------------------------------------------------------

Option Explicit

Const TITLE$ = "Import Entities & Attributes from Visio"
Const DEFAULT_RATIO_POSITION& = 25 ' Ratio between position in Visio Page & ER/Studio Diagram

Const DEFAULT_VISIO_DRAWING_FILE$ = "<YOUR_PATH><FILENAME>\LDM.vsdx" ' Path to your Visio Drawing
' Depending on the shapes you are using, you may have to edit these constants
Const DEFAULT_SHAPE_CATEGORIES = "User.msvShapeCategories"
Const DEFAULT_CATEGORY_ENTITY$ = "DbEntity"
Const DEFAULT_CATEGORY_ATTRIBUTE$ = "DbAttribute"
Const DEFAULT_PRIMARY_KEY$ = "PrimaryKey"
Const DEFAULT_FOREIGN_KEY$ = "ForeignKey"
Const DEFAULT_NULL_OPTION$ = "Required"

Sub Main

	' Visio
	Dim vsoApplication As Visio.Application 
	Dim vsoDocument As Visio.Document
	Dim vsoPage As Visio.Page
	Dim vsoShape As Visio.Shape
	Dim vsoAShape As Visio.Shape

	Dim lMemberID&, alShapeIDs&(), lLoop&
	Dim lLocationX&, lLocationY&
	Dim sDateSaved$, sPath$
	Dim lContainerID&, lNbImportedEntities&

	' Settings
	Dim iRatio%
	Dim sShapeCategories$
	Dim sDbEntity$
	Dim sDbAttribute$
	Dim sPrimaryKey$
	Dim sForeignKey$
	Dim sNullOption$

	' ER/Studio
	Dim MyDiagram As Diagram
	Dim MyModel As Model
	Dim MySubModel As SubModel
	Dim MyEntity As Entity
	Dim MyAttribute As AttributeObj

	Dim bNewProject As Boolean

	Debug.Clear
	lNbImportedEntities = 0

	Begin Dialog UserDialog 530,336,TITLE,.DialogFunc ' %GRID:10,7,1,1
		GroupBox 10,7,510,42,"Visio Drawing",.gbPath
		Text 20,21,50,14,"Path: ",.Text1,1
		TextBox 80,20,360,21,.Path
		PushButton 450,21,60,21,"Browse",.Browse
		GroupBox 10,56,280,49,"Import into",.gbImport
		OptionGroup .ogModel
			OptionButton 30,77,120,14,"New model",.obNew
			OptionButton 160,77,120,14,"Current model",.obCurrent
		GroupBox 300,56,220,49,"Entities positions",.gbRatio
		Text 310,77,60,14,"Ratio:",.tRatio,1
		TextBox 380,76,130,21,.tbRatio
		GroupBox 10,112,510,189,"Settings",.gbSettings
		Text 20,133,130,14,"Categories cell:",.tCell,1
		TextBox 160,132,350,21,.tbCell
		Text 20,161,130,14,"Entity category:",.tEntity,1
		TextBox 160,160,350,21,.tbEntity
		Text 20,189,130,14,"Attribute category:",.tAttribute,1
		TextBox 160,188,350,21,.tbAttribute
		Text 20,217,130,14,"Primary Key cell:",.tPK,1
		TextBox 160,216,350,21,.tbPK
		Text 20,245,130,14,"Foreign Key cell:",.tFK,1
		TextBox 160,244,350,21,.tbFK
		Text 20,273,130,14,"Null option cell:",.tNullOption,1
		TextBox 160,272,350,21,.tbNullOption
		OKButton 20,308,110,21
		CancelButton 400,308,110,21
	End Dialog

	Dim dlg As UserDialog

	start_dialog:
	dlg.Path = DEFAULT_VISIO_DRAWING_FILE
	dlg.tbRatio = "" & DEFAULT_RATIO_POSITION
	dlg.tbCell = DEFAULT_SHAPE_CATEGORIES
	dlg.tbEntity = DEFAULT_CATEGORY_ENTITY
	dlg.tbAttribute = DEFAULT_CATEGORY_ATTRIBUTE
	dlg.tbPK = DEFAULT_PRIMARY_KEY
	dlg.tbFK = DEFAULT_FOREIGN_KEY
	dlg.tbNullOption = DEFAULT_NULL_OPTION

	'start dialog
	If Dialog(dlg) = -1 Then

		' Open Visio
		Set vsoApplication = CreateObject("Visio.Application")

		'this Error Is For an errant file path, Dialog will be restarted
		On Error GoTo Error_open

		sPath = dlg.Path
		iRatio = Val(dlg.tbRatio)
		bNewProject = dlg.ogModel = 0
		sShapeCategories= dlg.tbCell
		sDbEntity= dlg.tbEntity
		sDbAttribute= dlg.tbAttribute
		sPrimaryKey= dlg.tbPK
		sForeignKey= dlg.tbFK
		sNullOption= dlg.tbNullOption

		' Open the Visio Drawing
		Set vsoDocument = vsoApplication.Documents.OpenEx sPath, visOpenRO

		On Error GoTo Error_unknown

		DiagramManager.EnableScreenUpdateEx(False, False)

		' Get the first page
		Set vsoPage = vsoApplication.ActiveDocument.Pages(1)

		If bNewProject Then

			' Create a new diagram.
			Set MyDiagram = DiagramManager.NewDiagram

		Else
			
			' Get current diagram.
			Set MyDiagram = DiagramManager.ActiveDiagram

		End If

		' A new diagram will automatically have a logical model - which is also the currently, active model.
		Set MyModel = MyDiagram.ActiveModel
	
		' Get the Main Model
		Set MySubModel = MyModel.ActiveSubModel
		MySubModel.ShowEntityNullOption = True
	
		' Document properties
		Debug.Print vsoDocument.FullName
		MyDiagram.Description = "Entities & Attributes imported from " & vsoDocument.FullName
		MyDiagram.ProjectName = vsoDocument.Title
		MyDiagram.Author = vsoDocument.Creator
		MyDiagram.Company = vsoDocument.Company
		MyDiagram.CopyrightYear = Format(vsoDocument.TimeSaved, "yyyy")
	
		' Loop on all Containers: Entities should be containers
		For Each lContainerID In vsoPage.GetContainers(visContainerExcludeNested)
			
			Set vsoShape = vsoPage.Shapes.ItemFromID(lContainerID)
	
			If HasCategory(vsoShape, sShapeCategories, sDbEntity) Then
	
				Debug.Print ""
	
				'Get location Shape
				GetShapePosition(vsoShape, lLocationX, lLocationY)
	
				Debug.Print "Entity: " & vsoShape.Text & " [" & vsoShape.Name & " - " & vsoShape.Cells(sShapeCategories).Formula() & "]" & " (" & lLocationX & ", " & lLocationY & ")"
	
				' Add the entity to the model.
				Set MyEntity = MyModel.Entities.Add(lLocationX * iRatio, - lLocationY * iRatio)
				MyEntity.EntityName = vsoShape.Text
				lNbImportedEntities = lNbImportedEntities + 1
	
				For Each lMemberID In vsoShape.ContainerProperties.GetMemberShapes(visContainerFlagsExcludeCallouts + visContainerFlagsExcludeContainers + visContainerFlagsExcludeConnectors + visContainerFlagsExcludeNested)
	
					Set vsoAShape = vsoPage.Shapes.ItemFromID(lMemberID)
	
					If HasCategory(vsoAShape, sShapeCategories, sDbAttribute) Then
	
						Debug.Print "Attribute: " & vsoAShape.Text & " [" & vsoAShape.Name & " - " & vsoAShape.Cells(sShapeCategories).Formula() & "]"
	
						' Add the attribute to the current entity
						Debug.Print "is PK: " & GetUserDefinedCellValue(vsoAShape, sPrimaryKey)
						Set MyAttribute = MyEntity.Attributes.Add(vsoAShape.Text, CBool(GetUserDefinedCellValue(vsoAShape, sPrimaryKey)))
	
						Debug.Print "is FK: " & GetUserDefinedCellValue(vsoAShape, sForeignKey)
	
						Debug.Print "is Not Null: " & GetUserDefinedCellValue(vsoAShape, sNullOption)
						If CBool(GetUserDefinedCellValue(vsoAShape, sNullOption)) Then
							
							MyAttribute.NullOption = "NOT NULL"
	
						Else
							
							MyAttribute.NullOption = "NULL"
	
						End If
	
					End If
	
				Next
	
				' Log the related objects to the current Entity
				alShapeIDs = vsoShape.ConnectedShapes(visConnectedShapesAllNodes, "")
	
				For lLoop = 0 To UBound(alShapeIDs)
	
					Set vsoAShape = vsoPage.Shapes.ItemFromID(alShapeIDs(lLoop))
					Debug.Print "Related objects: " & vsoAShape.Name & ": " & vsoAShape.Text
	
				Next
	
			Else
				
				Debug.Print "Ignored object in main loop: " & vsoShape.Type & "(" & vsoShape.Name & "): " & vsoShape.Text
	
			End If
	
		Next
	
		' Exit Visio
		vsoApplication.Quit
	
		MsgBox "Import completed." & vbCrLf & "(" & lNbImportedEntities & " entit" & IIf(lNbImportedEntities > 1, "ies", "y") & " created)", vbInformation, TITLE

		DiagramManager.EnableScreenUpdateEx(True, True)

	Exit Sub
	
		Error_open:
			MsgBox("Please enter a valid path.", vbExclamation, TITLE)
			GoTo start_dialog

		Error_unknown:
			MsgBox(Err.Description, vbExclamation, TITLE)
		
			If Not vsoApplication Is Nothing Then
				vsoApplication.Quit()
			End If

	End If

	DiagramManager.EnableScreenUpdateEx(True, True)

End Sub

Private Sub GetShapePosition(ByVal vsoShape As Visio.Shape, ByRef lLocationX&, ByRef lLocationY&)

	Dim celObj As Visio.Cell

	'Get location Shape
	' X
	Set celObj = vsoShape.Cells("PinX")

	If Not celObj Is Nothing Then
	
		lLocationX = celObj.Result("cm")

	Else
		
		lLocationX = 0

	End If

	' Y
	Set celObj = vsoShape.Cells("PinY")

	If Not celObj Is Nothing Then
	
		lLocationY = celObj.Result("cm")

	Else
		
		lLocationY = 0

	End If

End Sub

Private Function DialogFunc(DlgItem$, Action%, SuppValue&) As Boolean
	Select Case Action%
	Case 1 ' Dialog box initialization
		DlgEnable("obCurrent", (Not DiagramManager.ActiveDiagram Is Nothing))
	Case 2 ' Value changing or button pressed
		If DlgItem = "Browse" Then
			
			' Browse to Excel file if the user pushes browse button. Put path in text box.
			DlgText "path", GetFilePath(,"All Visio Files (*.vsdx;*.vsd;*.vsdm)|*.vsdx;*.vsd;*.vsdm|Visio Drawing (*.vsdx)|*.vsdx|Visio Macro-enabled Drawing (*.vsdm)|*.vsdm|Visio 2003-2010 Drawing (*.vsd)|*.vsd|All Files (*.*)|*.*",,"Open SpreadSheet", 0)
			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
	Case 3 ' TextBox or ComboBox text changed
		If DlgItem = "tbRatio" Then
					
			' Check if the value is a number
			Dim iValue%
			iValue = Val(DlgText "tbRatio")
			If (iValue = 0) And (DlgText("tbRatio") <> "0") Then
				MsgBox("Please enter a valid number.", vbExclamation, TITLE)
			End If

			DialogFunc = True

		End If
	Case 4 ' Focus changed
	Case 5 ' Idle
		Rem DialogFunc = True ' Continue getting idle actions
	Case 6 ' Function key
	End Select
End Function

Private Function HasCategory(vsoShape As Visio.Shape, sShapeCategories$, sCategory$) As Boolean

	Dim vsoCell As Visio.Cell

	If vsoShape.CellExists(sShapeCategories, False) Then

		Set vsoCell = vsoShape.Cells(sShapeCategories)
	
		HasCategory = InStr(";" & Mid(vsoCell.Formula, 2, Len(vsoCell.Formula) - 2) & ";", ";" & sCategory & ";") > 0

	Else
		
		HasCategory = False

	End If

End Function

Private Function GetUserDefinedCellValue(vsoShape As Visio.Shape, sKey$) As String
	
	Dim vsoCell As Visio.Cell

	If vsoShape.CellExists("User." & sKey, False) Then

		Set vsoCell = vsoShape.Cells("User." & sKey)

		GetUserDefinedCellValue = vsoCell.Formula

	Else
		
		GetUserDefinedCellValue = ""

	End If

End Function

Results

From the 2 samples, I have successfully generated 2 data models which include their entities and attributes:

Bugs Sample

Books Sample

Summary

In this post, we have provided 2 scripts which can be used to start writing your own macro to interact with Microsoft Visio.