Domain Bindings Import from Excel

      'TITLE:  DOMAIN BINDINGS IMPORT FROM EXCEL.BAS
      'DESCRIPTION:  This macro imports domain bindings from Excel.  I will map
      '	domains to attributes or columns depending on the data in the spread
      '	sheet.  The macro provides an interface to select the dictionary
      '	where the domains are located and the model to search for the attributes
      '	or columns.  When importing into a physical model the spread sheet
      '	must have the physical table and column names that match the selected
      '	physical model.  When importing into the logical model, the names in
      '	the spread sheet must match the entity and attribute names.
      
      'FORMAT OF SPREAD SHEET COLUMNS:
      
      '	1.  Diagram Name - Optional - String - Not used in import, used just for
      '			informational purposes in the spread sheet.
      '	2.  Model Name - Required - String - This is used to find the entity and attribute
      '			in the appropiate model from the spread sheet.
      '	3.  Entity/Table Name - Required - String - Needed to find the associated attribute
      '			and domain.
      '	4.	Attribute/Column Name - Required - String - Needed to find the associated domain
      '	5.  Attribute Datatype - Not required - String - Only for informational purposes
      '	6.  Attribute Datatype Length - Not required - String - Only for informational purposes
      '	7.  Attribute Datatype Precision - Not required - String - Only for information purposes
      '	8.  Domain Name - Required - String - Needed to match the domain with the attribute
      '	9.  Dictionary Name - Required - String - This column is used to find the correct
      '			dictionary for the domain from the spread sheet.  If blank, the local dictionary
      '			will be used
      
      'AUTHOR:  Jason Tiret
      'CONTACT:  http://support.embarcadero.com/
      'LAST UPDATE:  3/23/2004
      
      
      Dim diag As Diagram
      Dim dict As Dictionary
      Dim mdl As Model
      Dim ent As Entity
      Dim attr As AttributeObj
      Dim dom As Domain
      
      
      
      Sub Main
      	
      	Dim dom As Domain
      	Dim excel As Object
      	Dim error_log As String
      
      
      	Debug.Clear
      
      	Set diag = DiagramManager.ActiveDiagram
      
      	Begin Dialog UserDialog 520,294,"Import Domains Bindings From Excel",.DialogFunc ' %GRID:10,7,1,1
      		Text 30,21,210,14,"Path to binding info spreadsheet:",.Text1
      		TextBox 70,42,350,21,.path
      		OKButton 250,231,110,21
      		CancelButton 390,231,110,21
      		PushButton 440,42,60,21,"Browse",.Browse
      		TextBox 150,77,290,21,.diagram_name_txt
      		TextBox 150,112,290,21,.filename_txt
      		Text 40,84,100,14,"Active Diagram",.Text2
      		Text 70,119,60,14,"Filename",.Text4
      		CheckBox 50,168,290,21,"Log errors to c:\domain_binding_log.txt",.log_errors_chbx
      		PushButton 30,224,100,21,"Get Sample",.getsample
      	End Dialog
      
      
      	Dim dlg As UserDialog
      
      	'initialize dialog defaults, 0 = unchecked, 1 = checked
      	dlg.log_errors_chbx = 1
      
      
      
      	'start_dialog:
      	
      	'start dialog
      	If Dialog(dlg) = -1 Then
      
      	
      		'initialize excel object and make visible
      		Set excel = CreateObject("Excel.Application")
      		'excel.Visible = True
      	
      		'this error is for an errant file path, dialog will be restarted
      		'On Error GoTo Error_handle
      			
      		excel.workbooks.open dlg.path
      	
      
      		'define excel variables
      		Dim sheet As Object
      		Dim range As Object
      	
      		'range variables for loop
      		Dim binding_count As Integer
      		Dim start_range As Integer
      	
      		'get sheet info from excel object
      		Set sheet = excel.worksheets(1)
      		Set range = sheet.usedrange
      	
      		'get count for loop
      		binding_count = range.rows.Count
      		start_range = 2						'ignore first row of sheet.
      
      		'input diagram and model name in error log
      		error_log = "Diagram Name:       " & diag.ProjectName & vbCrLf
      		error_log = error_log & "File Name:          " & diag.FileName & vbCrLf & vbCrLf & vbCrLf & vbCrLf
      
      	
      		For i = start_range To binding_count
      
      			'make sure that the right data is initialized from the spread sheet.
      			'domain name = column 8 in sheet
      			'entity name = column 3 in sheet
      			'attribute name = column 4 in sheet
      			'datatype = column 5
      			'data length = column 6
      			'data precision = column 7
      	
      			Dim domain_name As String
      			Dim entity_name As String
      			Dim attribute_name As String
      			Dim datatype As String
      			Dim datalength As Integer
      			Dim dataprecision As Integer
      			Dim dictionary_name As String
      			Dim model_name As String
      
      			'initialize string variables with data from spread sheet.
      			model_name = Trim(range.cells(i,2).Value)
      			dictionary_name = Trim(range.cells(i,9).Value)
      			domain_name = Trim(range.cells(i, 8).Value)
      			entity_name = Trim(range.cells(i, 3).Value)
      			attribute_name = Trim(range.cells(i, 4).Value)
      
      			'check if it is an enterprise dictionary
      			Set dict = diag.EnterpriseDataDictionaries.Item(dictionary_name)
      
      			'use local if an enterprise dictionary is not found
      			If dict Is Nothing Then
      				Set dict = diag.Dictionary
      			End If
      
      			'check to see if dictionary in the spreadsheet matches the initialized dictionary
      			If dict.Name <> dictionary_name Then
      
      				error_log = error_log & "Row < " & i & " > -  Dictionary not found." & vbCrLf & vbCrLf
      
      			Else
      
      				Set dom = dict.Domains.Item(domain_name)
      	
      				If dom Is Nothing Then
      	
      					'log missing domain in the error string
      					error_log = error_log & "Row < " & i & " > -  Domain  <" & domain_name & "> does not exist." & vbCrLf & vbCrLf
      	
      				Else
      	
      					Set mdl = diag.Models.Item(model_name)
      	
      					If mdl Is Nothing Then
      	
      						error_log = error_log & "Row < " & i & " > -  Model  <" & model_name & "> does not exist." & vbCrLf & vbCrLf
      	
      					Else
      	
      						Set ent = mdl.Entities.Item(entity_name)
      		
      						If ent Is Nothing Then
      		
      							'log missing entity in the error string
      							error_log = error_log & "Row < " & i & " > -  Entity  <" & entity_name & "> does not exist." & vbCrLf & vbCrLf
      		
      						Else
      		
      							Set attr = ent.Attributes.Item(attribute_name)
      		
      							If attr Is Nothing Then
      		
      								'log missing attribute in the error string
      								error_log = error_log & "Row < " & i & " > -  Attribute  <" & entity_name & "." & attribute_name & "> does not exist." & vbCrLf & vbCrLf
      			
      							Else
      
      								If attr.ForeignKey = False  Then 'skip attribute if it is a foreign key.
      
      									'set the attribute domain ID equal to the domain ID to bind the domain
      									'to the attribute.
      									attr.DomainId = dom.ID
      
      								End If
      
      							End If 'attribute existence check
      		
      						End If	  'entity existence check
      	
      					End If		  'model existence check
      	
      				End If            'domain existence check
      
      			End If			  'dictionary existence check.
      
      		Next
      	
      		excel.workbooks.Close
      		'excel.visible = False
      
      		If dlg.log_errors_chbx = 1 Then
      
      			Open "C:\domain_binding_log.txt" For Output As #1
      			Print #1, error_log
      			Close #1
      
      		End If
      
      		MsgBox("Import of Domain Bindings Complete.",vbOkOnly,"ERStudio")
      	
      		Exit Sub
      	
      		'Error_handle:
      		'	MsgBox("Please enter a valid path.",,"Error!")
      		'	GoTo start_dialog
      
      	End If
      
      End Sub
      
      
      
      
      'This function checks to see if a domain exists in the model
      'it returns TRUE if it exists and FALSE if it doesn't
      Function DomainExists ( DName As String ) As Boolean
      
      	Dim dom As Domain
      
      	For Each dom In dict.Domains
      
      		If UCase(dom.Name) = UCase(DName) Then
      
      			DomainExists = True
      			Exit Function
      
      		End If
      
      	Next
      
      	DomainExists = False
      
      End Function
      
      'this function is used to print a sample sheet for the import format.
      Sub PrintSampleSheet()
      
      	Dim ex As Object
      	Dim wb, ws As Variant
      
      	Set ex = CreateObject("excel.application")
      	ex.visible = True
      
      	Set wb = ex.workbooks.Add
      	Set ws = wb.activesheet
      
      	ws.cells(1,1).Value = "Diagram"
      	ws.cells(1,2).Value = "Model"
      	ws.cells(1,3).Value = "Entity/Table"
      	ws.cells(1,4).Value = "Attribute/Column"
      	ws.cells(1,5).Value = "Attribute Datatype"
      	ws.cells(1,6).Value = "Attribute Datatype Length"
      	ws.cells(1,7).Value = "Attribute Datatype Precision"
      	ws.cells(1,8).Value = "Domain Name"
      	ws.cells(1,9).Value = "Dictionary"
      
      
      	ws.cells(2,1).Value = "string - Optional"
      	ws.cells(2,2).Value = "string - Required"
      	ws.cells(2,3).Value = "string - Required"
      	ws.cells(2,4).Value = "string - Required"
      	ws.cells(2,5).Value = "string - Optional"
      	ws.cells(2,6).Value = "Numeric - Optional"
      	ws.cells(2,7).Value = "Numeric - Optional"
      	ws.cells(2,8).Value = "String - Required"
      	ws.cells(2,9).Value = "String - Required"
      
      
      
      	With ws.range(ws.cells(1,1),ws.cells(1,9))
      		.font.Size = 12
      		.font.Bold = True
      		.columnwidth = 30
      	End With
      
      	ws.range(ws.cells(2,1),ws.cells(2,9)).wraptext = True
      
      End Sub

---

      Rem See DialogFunc help topic for more information.
      Private Function DialogFunc(DlgItem$, Action%, SuppValue&) As Boolean
      	Select Case Action%
      	Case 1 ' Dialog box initialization
      
      		'make diagram and file name text blocks read only
      		DlgEnable "diagram_name_txt", False
      		DlgEnable "filename_txt", False
      
      		'populate the diagram and file name text blocks with the appropiate data.
      		DlgText "diagram_name_txt", diag.ProjectName
      		DlgText "filename_txt", diag.FileName
      
      	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(,"xls",,"Open SpreadSheet")
      			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.",,"Error!")
      			DialogFunc = True
      		ElseIf DlgItem = "getsample" Then
      			PrintSampleSheet
      			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