'TITLE: IMPORT DOMAINS FROM EXCEL (ENTERPRISE)
'DESCRIPTION: This macro imports domains from the specified excel
' spreadsheet. Domains already in the domain list in ERStudio will
' be ignored. As well as duplicate names in the spreadsheet.
' Domain name (first column in spreadsheet) and Attribute
' name and Column name must be unique. The only required field
' in the spreadsheet is the first column.
'
'README: The format of the spreadsheet must be a certain order for
' the information to be imported correctly. The first row of the
' spreadsheet is ignored. This is reserved for the column titles.
' Records will be imported starting with the second row. The order
' of the columns must be as stated below.
'
' 1. Domain Name - Required - String - Non-unique values will be
' ignored.
' 2. Attribute Name - Not required - String - Non-unique
' values will be ignored. If this is blank the Domain Name
' is used.
' 3. Column Name - Not required - String - Non-unique
' values will be ignored. If this is blank the Domain Name
' is used.
' 4. Domain Folder - Not required - String - Must not be the same name
' as an existing domain or domain folder.
' 5. Domain Definition - Not required - String
' 6. Domain Note - Not required - String
' 7. Datatype - Not Required - String - Must be a valid Logical
' datatype. See Datatype dropdown in domain editor for
' list.
' 8. Datatype Width - Not Required - Numeric
' 9. Datatype Scale - Not Required - Numeric
' 10. Allow Nulls - Not Required - Valid values: YES or NO (not
' case-sensitive) - This is required to be YES if the
' Domain is to be an IDENTITY.
' 11. IDENTITY column - Not Required - YES or NO
' 12. Seed - Not Required - Numeric - If this is left blank or the
' value is not numeric when IDENTITY is YES, a value of 1
' will be used.
' 13. Increment - Not Required - Numeric - If this is left blank or the
' value is not numeric when IDENTITY is YES, a value of 1
' will be used.
'AUTHOR: Jason Tiret
'LAST UPDATE: 5/27/2003
Dim diag As Diagram
Dim dict As Dictionary
Dim dictionary_list () As String
Sub Main
Dim dom As Domain
Dim excel As Object
Debug.Clear
Set diag = DiagramManager.ActiveDiagram
Debug.Clear
Debug.Print diag.ActiveModel.Name
Begin Dialog UserDialog 520,343,"Import Domains From Excel",.DialogFunc ' %GRID:10,7,1,1
DropListBox 160,21,320,133,dictionary_list(),.dictionary_select
Text 40,56,170,14,"Path to XLS spreadsheet:",.Text1
TextBox 70,84,340,21,.path
OKButton 230,301,110,21
CancelButton 380,301,110,21
PushButton 430,84,60,21,"Browse",.Browse
Text 50,126,340,42,"Note: Domains must be in Sheet 1. See ReadMe for the format of the sheet. Double-click on macro to view ReadMe.",.Text2
OptionGroup .UpdateChoice
OptionButton 80,189,340,14,"Update existing domains from spread sheet",.OptionButton1
OptionButton 80,224,340,14,"Ignore existing domains from spread sheet",.OptionButton2
PushButton 80,266,160,21,"Get Sample Sheet",.getsample
Text 30,28,120,14,"Select Dictionary:",.Text3
End Dialog
init_dictionary_list
Dim dlg As UserDialog
'default option for update radio button, 0 = update, 1 = ignore
dlg.updatechoice = 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
If dictionary_list(dlg.dictionary_select) = "Local" Then
Set dict = diag.Dictionary
Else
Set dict = diag.EnterpriseDataDictionaries.Item(dictionary_list(dlg.dictionary_select))
End If
ImportDomains(excel, dlg.updatechoice)
' If dlg.UDT = 1 Then
' ImportUDTs(excel)
' End If
' If dlg.rule = 1 Then
' ImportRules(excel)
' End If
' If dlg.default = 1 Then
' ImportDefaults(excel)
' End If
excel.workbooks.Close
'excel.visible = False
Exit Sub
'Error_handle:
' MsgBox("Please enter a valid path.",,"Error!")
' GoTo start_dialog
End If
End Sub
'initialize the dictionary drop down list
Sub init_dictionary_list
ReDim dictionary_list (0 To diag.EnterpriseDataDictionaries.Count) As String
dictionary_list (0) = "Local"
i = 1
For Each dict In diag.EnterpriseDataDictionaries
dictionary_list (i) = dict.Name
i = i + 1
Next
End Sub
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
Function ImportDomains(ex As Variant, updatebit As Integer)
Dim sheet As Object
Dim range As Object
Dim DomCount As Integer
Dim dom As Domain
Dim dom_folder As DomainFolder
Set sheet = ex.worksheets(1)
Set range = sheet.usedrange
range.select
'On Error GoTo message
'message:
DomCount = range.rows.Count
Debug.Print "Domain Count = " & DomCount
If DomCount >= 2 Then
For i = 2 To DomCount
If range.cells(i,1).Value <> "" Then
If DomainExists(range.cells(i,1).Value) = False Then
GoTo CREATE
Else
If updatebit = 1 Then
GoTo IGNORE
Else
GoTo UPDATE
End If
End If
CREATE:
If range.cells(i, 4).Value = "" Then
'Domain Folder field is blank in spread sheet
'create domain, use domain name for attribute/column name if attribute/column name is blank
If range.cells(i,2).Value = "" And range.cells(i,3).Value = "" Then
Set dom = dict.Domains.AddEx(range.cells(i,1).Value, range.cells(i,1).Value, range.cells(i,1).Value,"")
ElseIf range.cells(i,2).Value = "" And range.cells(i,3).Value <> "" Then
Set dom = dict.Domains.AddEx(range.cells(i,1).Value, range.cells(i,1).Value, range.cells(i,3).Value,"")
ElseIf range.cells(i,2).Value <> "" And range.cells(i,3).Value = "" Then
Set dom = dict.Domains.AddEx(range.cells(i,1).Value, range.cells(i,2).Value, range.cells(i,1).Value,"")
Else
Set dom = dict.Domains.AddEx(range.cells(i,1).Value, range.cells(i,2).Value, range.cells(i,3).Value,"")
End If
Else
'Domain folder is in Spread sheet
Set dom_folder = dict.DomainFolders.Item(range.cells(i,4).Value)
'check if domain folder doesn't exist then added it
If dom_folder Is Nothing Then
Set dom_folder = dict.DomainFolders.Add(range.cells(i,4).Value,"")
End If
'create domain with domain folder, use domain name for attribute/column name if attribute/column name is blank
If range.cells(i,2).Value = "" And range.cells(i,3).Value = "" Then
Set dom = dict.Domains.AddEx(range.cells(i,1).Value, range.cells(i,1).Value, range.cells(i,1).Value,dom_folder.ID)
ElseIf range.cells(i,2).Value = "" And range.cells(i,3).Value <> "" Then
Set dom = dict.Domains.AddEx(range.cells(i,1).Value, range.cells(i,1).Value, range.cells(i,3).Value,dom_folder.ID)
ElseIf range.cells(i,2).Value <> "" And range.cells(i,3).Value = "" Then
Set dom = dict.Domains.AddEx(range.cells(i,1).Value, range.cells(i,2).Value, range.cells(i,1).Value,dom_folder.ID)
Else
Set dom = dict.Domains.AddEx(range.cells(i,1).Value, range.cells(i,2).Value, range.cells(i,3).Value,dom_folder.ID)
End If
'Debug.Print DiagramManager.GetLastErrorString
End If
GoTo SKIPUPD
UPDATE:
For Each dom In dict.Domains
If UCase(dom.Name) = UCase(range.cells(i,1).Value) Then
Exit For
End If
Next
If range.cells(i,2).Value <> "" Then
dom.AttributeName = range.cells(i,2).Value
End If
If range.cells(i,3).Value <> "" Then
dom.ColumnName = range.cells(i,3).Value
End If
SKIPUPD:
Debug.Print "i = " & i & " " & DiagramManager.GetLastErrorString
'Set definition if spreadsheet column is not blank
If range.cells(i,5).Value <> "" Then
dom.Definition = range.cells(i,5).Value
End If
'Set note if spreadsheet column is not blank
If range.cells(i,6).Value <> "" Then
dom.Note = range.cells(i,6).Value
End If
'Set datatype if spreadsheet column is not blank
If range.cells(i,7).Value <> "" Then
dom.Datatype = UCase(range.cells(i,7).Value)
End If
'set width if spreadsheet column is not blank
If IsNumeric(range.cells(i,8).Value) = True Then
dom.DataLength = CLng(range.cells(i,8).Value)
End If
'set scale if spreadsheet column is not blank
If IsNumeric(range.cells(i,9).Value) = True Then
dom.DataScale = CLng(range.cells(i,9).Value)
End If
'set nullability if spreadsheet column is not blank, valid values "yes" or "no", not case-sensitive
If UCase(range.cells(i,10).Value) = "YES" Then
dom.Nullable = True
ElseIf UCase(range.cells(i,10).Value) = "NO" Then
dom.Nullable = False
End If
'set identity if speadsheet is not null
If UCase(range.cells(i,11).Value) = "YES" Then
dom.Identity = True
'add Identity seed if value is specified in spread sheet, use 1 otherwise
If IsNumeric(range.cells(i,12).Value) = True And range.cells(i,12).Value <> "" Then
dom.IdentitySeed = CLng(range.cells(i,12).Value)
Else
dom.IdentitySeed = 1
End If
'set increment value if specified in spread sheet, use 1 otherwise
If IsNumeric(range.cells(i,13).Value) = True And range.cells(i,13).Value <> "" Then
dom.IdentityIncrement = CLng(range.cells(i,13).Value)
Else
dom.IdentityIncrement = 1
End If
End If
End If
IGNORE:
Next
End If
'message:
' MsgBox("There is no ""Domains"" sheet in the workbook or the name is invalid. Domains will not be imported.")
' Exit Function
End Function
Function ImportUDTs(ex As Variant)
Dim sheet As Object
Dim range As Object
On Error GoTo UDTMessage
Set sheet = ex.worksheets("User Datatypes")
Set range = sheet.usedrange
UDTMessage:
MsgBox("There is no ""User Datatypes"" sheet in the workbook or the name is invalid. Entity Definitions will be ignored.")
Exit Function
End Function
Function ImportRules(ex As Variant)
Dim sheet As Object
Dim range As Object
On Error GoTo RuleMessage
Set sheet = ex.worksheets("Rules")
Set range = sheet.usedrange
RuleMessage:
MsgBox("There is no ""Rules"" sheet in the workbook or the name is invalid. Entity Definitions will be ignored.")
Exit Function
End Function
Function ImportDefaults(ex As Variant)
Dim sheet As Object
Dim range As Object
On Error GoTo DefaultMessage
Set sheet = ex.worksheets("Defaults")
Set range = sheet.usedrange
DefaultMessage:
MsgBox("There is no ""Defaults"" sheet in the workbook or the name is invalid. Entity Definitions will be ignored.")
Exit Function
End Function
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 = "Domain Name"
ws.cells(1,2).Value = "Attribute Name"
ws.cells(1,3).Value = "Column Name"
ws.cells(1,4).Value = "Domain Folder"
ws.cells(1,5).Value = "Domain Definition"
ws.cells(1,6).Value = "Domain Note"
ws.cells(1,7).Value = "Datatype"
ws.cells(1,8).Value = "DataType Width"
ws.cells(1,9).Value = "DataType Scale"
ws.cells(1,10).Value = "Allow Nulls"
ws.cells(1,11).Value = "Identity column"
ws.cells(1,12).Value = "Identity Seed"
ws.cells(1,13).Value = "Identity Increment"
ws.cells(2,1).Value = "string - required"
ws.cells(2,2).Value = "string - optional, default Domain Name"
ws.cells(2,3).Value = "string - optional, default Domain Name"
ws.cells(2,4).Value = "string - optional"
ws.cells(2,5).Value = "string - optional"
ws.cells(2,6).Value = "string - optional"
ws.cells(2,7).Value = "Valid Domain Datatype - Optional"
ws.cells(2,8).Value = "Numeric - optional"
ws.cells(2,9).Value = "Numeric - optional"
ws.cells(2,10).Value = "Yes or No - optional, case-insensitive"
ws.cells(2,11).Value = "Yes or No - optional, case-insensitive"
ws.cells(2,12).Value = "Numeric - optional, default 1"
ws.cells(2,13).Value = "Numeric - optional, default 1"
With ws.range(ws.cells(1,1),ws.cells(1,13))
.font.Size = 12
.font.Bold = True
.columnwidth = 30
End With
ws.range(ws.cells(2,1),ws.cells(2,13)).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
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 = "getsample" Then
PrintSampleSheet
DialogFunc = True
ElseIf DlgItem = "OK" And DlgText("path") = "" Then
'don't exit dialog if a path is not specified
MsgBox("Please enter a valid path.",,"Error!")
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