'TITLE: IMPORT INDEX NAMES FROM EXCEL 'DESCRIPTION: This macro is used to import relationship names from ' Microsoft Excel. A sample spreadsheet can be printed when ' executing the macro. Read the below ReadMe for the valid values ' of each column in the spreadsheet. 'AUTHOR: Jason Tiret 'CONTACT: http://support.embarcadero.com/ 'LAST MODIFY DATE: 1/29/2003 'README: This defines datatypes and constraints on each column of ' the speadsheet. The first row of the spread sheet is reserved for ' column headers. Values in the first row will be ignored. ' The specified column order is required for proper import. All ' columns are required in the spreadsheet, but some may have null ' values. 'FORMAT OF SPREAD SHEET: '(Column Order Number) Column Name - Datatype - Description ' (1) Table Name - String - This is required in the ' spread sheet. The name of the table is used to match ' the model table with the entry in the spreadsheet. ' Unmatched entries in the spreadsheet will be logged to ' C:\Indx_import.txt. ' (2) Index Name - String - This is required in the ' spread sheet. The name of the index is used to match ' the model index with the entry in the spreadsheet. ' Unmatched entries in the spreadsheet will be logged to ' C:\Indx_import.txt. ' (3) Index Type - String - This is the type of the relationship. ' It is not required for importing the names. PK - Primary Key, ' AK - Alternate Key (Unique), IE - Inversion Entry (Non-unique) ' (4) Index Member Column - String - This is the name of the ' migrated column in the child table. This is not needed to ' import the information into the model. ' (5) New Index Name - String - This is the new name ' of the relationship. The relationship specified in column ' one will be updated with this name Dim diag As Diagram Dim mdl As Model Dim errorlog As String Sub Main Dim refval As ReferenceValue Dim excel As Object Debug.Clear Set diag = DiagramManager.ActiveDiagram Set mdl = diag.ActiveModel Debug.Clear 'Debug.Print diag.ActiveModel.Name Begin Dialog UserDialog 510,210,"Import Index Names From Excel",.DialogFunc ' %GRID:10,7,1,1 Text 40,14,170,14,"Path to XLS spreadsheet:",.Text1 TextBox 70,35,340,21,.path OKButton 200,168,110,21 CancelButton 350,168,110,21 PushButton 430,35,60,21,"Browse",.Browse Text 50,112,400,35,"Note: Index info must be in Sheet 1. See ReadMe for the format of the sheet. Double-click on macro to view ReadMe.",.Text2 PushButton 60,70,150,28,"Get Sample Sheet",.SampleSheet End Dialog Dim dlg As UserDialog 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,,True 'readonly:=True ImportIndexes(excel) excel.Workbooks.Close 'excel.visible = False MsgBox("Import Complete!",,"ER/Studio") Exit Sub Error_handle: MsgBox("Please enter a valid path.",,"Error!") GoTo start_dialog End If End Sub Function ImportIndexes(ex As Variant) Dim sheet As Object Dim range As Object Dim IndxCount As Integer Dim ent As Entity Dim indx As Index Dim indx_name As String Dim ent_name As String Dim new_indx_name As String Set sheet = ex.worksheets(1) Set range = sheet.usedrange range.select IndxCount = range.rows.Count If IndxCount >= 2 Then errorlog = "Unmatched Entries in SpreadSheet::" & vbCrLf & vbCrLf For i = 2 To IndxCount If range.cells(i,1).Value <> "" Then ent_name = Trim(range.cells(i,1).Value) indx_name = Trim(range.cells(i,2).Value) new_indx_name = Trim(range.cells(i,5).Value) Set ent = mdl.Entities.Item(ent_name) If ent Is Nothing Then errorlog = errorlog & "Table Name: " & ent_name & vbCrLf & vbCrLf Else Set indx = ent.Indexes.Item(indx_name) If indx Is Nothing Then errorlog = errorlog & "Table Name: " & ent_name & vbCrLf errorlog = errorlog & vbTab & "Index Name: " & indx_name & vbCrLf & vbCrLf Else 'update model with new Index name If new_indx_name <> "" Then indx.Name = new_indx_name End If End If End If End If Next Open "C:\Indx_import.txt" For Output As #1 Print #1, errorlog Close #1 End If 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 = "Table Name" ws.cells(1,2).Value = "Index Name" ws.cells(1,3).Value = "Index Type" ws.cells(1,4).Value = "Indexed Column" ws.cells(1,5).Value = "New Index Name" ws.cells(2,1).Value = "Number - required" ws.cells(2,2).Value = "string - optional" ws.cells(2,3).Value = "string - optional" ws.cells(2,4).Value = "string - optional" ws.cells(2,5).Value = "string - optional" With ws.range(ws.cells(1,1),ws.cells(1,5)) .font.Size = 10 .font.Bold = True .columnwidth = 30 End With 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 = "SampleSheet" 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