Macro: Create table from Excel

This was a requested macro to create a table from an Excel spreadsheet.  This was mainly used for Oracle but can be modified for other database platforms.

The macro will try to determine whether a column is a DATE, NUMERIC, CHAR, or VARCHAR2 and get the max value for that.  

The first row is the header row which will be the name for the name of the column in Data Architect.  The table name will be the filename.

For the DATE column it will look at the header and if the word "date" appears in the name, then it'll treat the whole Excel column as date.

For the NUMERIC column it will determine the max value and the precision

This macro will also try to limit the length of column names to be 30 characters.


8713.Create table from Excel v1.1.txt
' version 1.1
' 	- columns will be in uppercase
'	- limit column names to 30 characters
'	- fixed table name truncation
'	- table names will now be in uppercase
' 	- will look in the entire name for "Date" and set the column as date instead of at the end of the name
' 	- changed the null option to "null" from the default of "not null"

'define excel variables
	Dim Excel As Object
	Dim sheet As Object
	Dim range As Object
	Dim rowCount As Integer
	Dim colCount As Integer

	Dim isNumber As Boolean

	Dim precision As Long

Sub Main

	Begin Dialog UserDialog 720,105,"Import From Excel Spreadsheet",.DlgFunc ' %GRID:10,7,1,1
		Text 10,21,120,14,"Excel File Path:",.txtFile
		TextBox 150,21,450,21,.edFileName
		PushButton 610,21,90,21,"Select File",.btnSelectFile
		PushButton 260,70,90,21,"Import",.btnImport
		CancelButton 380,70,90,21,.btnExit
	End Dialog
	Dim dlg As UserDialog

	If (DiagramManager.ActiveDiagram Is Nothing) Then
		MsgBox "Please open a diagram file before running the macro.", vbExclamation
		Exit Sub
	End If

	If Dialog(dlg) = 0 Then Exit Sub

End Sub

Rem See DialogFunc help topic for more information.
Private Function DlgFunc(DlgItem$, Action%, SuppValue&) As Boolean
	Dim fileName As String
	Dim fileExt As String

	Select Case Action%
	Case 1 ' Dialog box initialization
	Case 2 ' Value changing or button pressed

		Select Case DlgItem$
	        Case "btnSelectFile"

					fileName = GetFilePath(,"xls;xlsx",,"Open File", 0)

					If (fileName <> "") Then
						DlgText("edFileName", fileName)
					End If

	                DlgFunc = True
	                Exit Function

            Case "btnImport"

                    fileName = DlgText("edFileName")

                    If Len(fileName) = 0 Then
                            MsgBox "You must specify a file."
                            DlgFunc = True
                            Exit Function
                    	If Not FileExists(fileName) Then
                            MsgBox "Specified file does not exist."
                            DlgFunc = True
                            Exit Function
							fileExt =  Right$(fileName, Len(fileName) - InStrRev(fileName, "."))
							If (LCase(Left(fileExt, 3)) <> "xls") Then
								MsgBox("You can only select Excel spreadsheets.", vbExclamation)
								Exit Function
							End If
                        End If
                    End If


                    DlgFunc = False
                    Exit Function

            Case "btnExit"
                    DlgFunc = False
                    Exit Function
        End Select
	Case 3 ' TextBox or ComboBox text changed
	Case 4 ' Focus changed
	Case 5 ' Idle
		Rem DlgFunc = True ' Continue getting idle actions
	Case 6 ' Function key
	End Select
End Function
Function FileExists(ByVal fileName As String) As Boolean

	FileExists = (Dir(fileName) <> "")

End Function

Sub doImport(file_name As String)

	Dim theDiagram As Diagram
	Dim theModel As Model

	'initialize excel object and make visible
	Set Excel = CreateObject("Excel.Application")
	Excel.Visible = True file_name
	'get sheet info from excel object
	Set sheet = Excel.worksheets(1)
	Set range = sheet.usedrange
	rowCount = range.rows.Count
	colCount = range.columns.Count

	Set theDiagram = DiagramManager.ActiveDiagram
	Set theModel = theDiagram.ActiveModel

	Dim entity_name As String
	entity_name = Right(file_name,Len(file_name) - InStrRev(file_name,"\"))

	' v 1.1 - fixed truncation issue with name of the file/entity_name
	'		  and make sure it's in uppercase
	entity_name = UCase(Left(entity_name, InStrRev(entity_name,".")-1))
	Debug.Print "Filename:  " & entity_name

	createTable(theModel, entity_name)

End Sub

Sub createTable(theModel As Model, entity_name As String)

	Dim theEntity As Entity
	Dim theAttribute As AttributeObj

	Dim I As Integer
	Dim theMax As Integer

	' get the name of the file to use as the table name

	Dim colName As String
	Dim dataType As String
	Dim DTWidth As Integer

	entity_name = EntityExist(entity_name, theModel)
	Debug.Print "entityName: " & entity_name
	Set theEntity = theModel.Entities.Add(0,0)
	theEntity.EntityName = entity_name
	theEntity.TableName = entity_name

	For I = 1 To colCount
			' set isNumber as true
		isNumber = True
		' v 1.1 - make all column names caps
		colName = UCase(Trim(range.cells(1,I).Value))
		' v 1.1 - limit column names to 30 characters
		colName = Left(colName, 30)
		Debug.Print "ColName: " & colName
		theMax = maxInCol(I,rowCount)
		'Debug.Print "max Range:  " & theMax
		'Debug.Print "IsNumber: " & isNumber

		'v 1.1 - changed this to look for "DATE" anywhere in the name
		'		 instead of at the end.
		' If Right(UCase(colName),4) = "DATE" Then
		If InStr(1,UCase(colName), "DATE") > 0 Then
			dataType = "DATE"
			DTWidth = 0
		ElseIf isNumber Then
			dataType = "NUMERIC"
			DTWidth = theMax
			If theMax = 1 Then
				dataType = "CHAR"
				DTWidth = 1
				If theModel.Logical Then
					dataType = "VARCHAR"
					dataType = "VARCHAR2"
				End If
				DTWidth = theMax
			End If

		End If

		Debug.Print "DataType:  " & dataType
		Debug.Print "Width:  "& DTWidth
		Debug.Print ""

		Set theAttribute = theEntity.Attributes.Add(colName,False)
		theAttribute.Datatype = dataType
		If precision > 0 Then
			theAttribute.DataLength = DTWidth - precision - 1
			theAttribute.DataScale = precision
			theAttribute.DataLength = DTWidth
		End If
		' v 1.1 added nullOption To Null
		theAttribute.NullOption = "NULL"


End Sub

Function ColumExist(colName As String, theEntity As Entity) As String
	Dim theAttribute As AttributeObj
	Dim newAttributeName As String
	Dim delim As Integer

	newAttributeName = colName


	Set theAttribute = theEntity.Attributes.Item(colName)
	If theAttribute Is Nothing Then
		ColumnExist = newAttributeName
		Exit Function
		' if the colName ends with _n
		delim = InStrRev(newAttributeName,"_")
		If Len(newAttributeName) > 28 Then
			newAttributeName = Left(newAttributeName,28)
		End If
		If delim > 0 Then
			newAttributeName = Left (newAttributeName,delim) & Right (newAttributeName,Len(newAttributeName) - delim) + 1
			newAttributeName = newAttributeName & "_1"
		End If

		GoTo theStart:

	End If

End Function

Function EntityExist(entity_name As String, theModel As Model) As String

	Dim theEntity As Entity
	Dim newEntityName As String

	Dim delim As Integer

	newEntityName = entity_name


	Set theEntity = theModel.Entities.Item(newEntityName)
	If theEntity Is Nothing Then
		EntityExist = newEntityName
		Exit Function
		' if the entity_name ends with _n
		delim = InStrRev(newEntityName,"_")
		If delim > 0 Then
			newEntityName = Left (newEntityName,delim) & Right (newEntityName,Len(newEntityName) - delim) + 1
			newEntityName = newEntityName & "_1"
		End If

		GoTo theStart:

	End If
End Function

' Loop through to find the largest string in a column
' and determine if the column is a string or number
Function maxInCol(col As Integer, size As Integer)
	Dim I As Integer
	maxInCol = 0
	precision = 0
Debug.Print "size:  " & size
	For I = 2 To size
		' ignore blank cells
		If Trim(range.Cells(I,col)) <> "" Then
			'only test if a cell is a number if IsNumber = true
			If isNumber Then
				isNumber = IsNumeric(Trim(range.Cells(I,col)))
				Debug.Print "isNumber: " & isNumber & "   value:  " & range.Cells(I,col) & " value:  " & range.Cells(I,1) & "   I:  " & I
				If AfterPoint(range.Cells(I,col)) > precision Then
					precision = AfterPoint(range.Cells(I,col))
				End If
			End If
			If Len(range.cells(I,col).Value) > maxInCol Then
				maxInCol = Len(range.cells(I,col))
		 	End If
		End If

End Function

Function AfterPoint(S As String) As Long
  AfterPoint = Len(Split(S & ".", ".")(1))
End Function