Option explicit
public msTableSchema as string
public msTableName as string
public msTableSpace as string
public msPCTFREE as string
public msPCTUSED as string
public msPCTIncrease as string
public msInitial as string
public msNext as string
public msMinExtents as string
public msMaxExtents as string
public msOptimal as string
public objAccessConnection as connection
public objOracleConnection as connection
Private Sub cmdDesign_Click()
On Error GoTo cmdDesign_Click_Error
Dim sSQL as string
Dim objTableDefs as tabledefs
dim objTableDef as tabledef
msTableSchema =input("Enter Schema Name")
msTableName=input("Enter Table Name")
msTableSpaceName=input("Enter Tablespace Name")
msPCTFREE="30"
msPCTUSED="70"
msPCTIncrease=0"
msInitial="200k"
msNext="20k"
msMinExtents="1"
msMaxExtents="121"
Set objTableDefs = objAccessConnection.TableDefs
Set objTableDef = Nothing
For Each objTableDef In objTableDefs
If InStr(1, objTableDef.Name, sTableName) > 0 Then
Set msobjTableDef = objTableDef
Exit For
End If
Next
sSQL=createTableSQL()
objOracleConnection.execute sSQL
Exit_cmdDesign_Click:
Exit Sub
cmdDesign_Click_Error:
#If gnDebug Then
Stop
Resume
#End If
msgbox Err.Description
Resume Exit_cmdDesign_Click
End Sub
--------------------------------------------------------------------------------
Private Function createTableSQL() As String
Dim sSQL As String
Dim i As Integer
Dim sField_Name As String
Dim sField_Size As String
Dim sData_Type As String
Dim bNullable As Boolean
Dim sPhrase As String
Dim sINITIAL As String
Dim sNEXT As String
Dim sPCTINCREASE As String
Dim sPCTFREE As String
Dim sPCTUSED As String
Dim sMaxExtents As String
Dim sMINEXTENTS As String
Dim sOPTIMAL As String
Dim sTableName As String
Dim sTablespace As String
Dim sOwner As String
Dim iCount As Integer
Dim lAccess_Data_Type As Long
Dim objIndex As Object
Dim objField As Object
Dim bDone_Flag As Boolean
On Error GoTo createTableSQL_Error
Screen.MousePointer = vbHourglass
If msTableSchema = "" Then
MsgBox "Please select a table schema"
GoTo Exit_createTableSQL
End If
If msTableName = "" Then
MsgBox "Please enter in a Table Name"
GoTo Exit_createTableSQL
End If
If msTableSpace = "" Then
MsgBox "Please enter in a Tablespace to assign
the table"
GoTo Exit_createTableSQL
End If
If msPCTFREE <> "" Then
If Not IsNumeric(msPCTFREE) Then
MsgBox "PCTFREE must be numeric"
GoTo Exit_createTableSQL
End If
End If
If msPCTUSED <> "" Then
If Not IsNumeric(msPCTUSED) Then
MsgBox "PCTUSED must be numeric"
GoTo Exit_createTableSQL
End If
End If
If mobjTableDef Is Nothing Then
MsgBox "You must change the SQL directly"
GoTo Exit_createTableSQL
End If
Screen.MousePointer = vbHourglass
sOwner = msTableSchema.Text
sPCTFREE = msPCTFREE
sPCTUSED = msPCTUSED
If msPCTIncrease = "" Then
sPCTINCREASE = 0
Else
sPCTINCREASE = msPCTIncrease
End If
sINITIAL = msInitial
sNEXT = msNext
sMINEXTENTS = msMinExtents
sMaxExtents = msMaxExtents
sOPTIMAL = msOptimal
sTableName = msTableName
sTablespace = msTableSpace
sSQL = "create table " & sTableName & Chr(13) & Chr(10)
sSQL = sSQL & " (" & Chr(13) & Chr(10)
iCount = mobjTableDef.Fields.Count
For i = 0 To iCount - 1
sField_Name = mobjTableDef.Fields(i).Name
lAccess_Data_Type =
mobjTableDef.Fields(i).Type
sData_Type =
ConvertOracleType(lAccess_Data_Type)
Select Case lAccess_Data_Type
Case dbLong
sField_Size = "10"
Case dbDouble
sField_Size = "14,8"
Case dbSingle
sField_Size = "12,7"
Case dbInteger
sField_Size = "5"
Case dbBigInt
sField_Size = "20,0"
Case dbByte
sField_Size = "2"
Case Else
sField_Size = "" &
mobjTableDef.Fields(i).Size
End Select
If mobjTableDef.Fields(i).Required = True Then
bNullable = False
Else
bNullable = True
End If
sPhrase = ""
If i > 0 Then
sPhrase = ","
End If
If sData_Type = "DATE" Or _
sData_Type = "XBOOLEAN" Or _
sData_Type = "SMALLINT" Or _
sData_Type = "FLOAT" Or _
sData_Type = "DOUBLE PRECISION" Or _
sData_Type = "LONG RAW" Or _
sData_Type = "LONG" Or _
sData_Type = "NUMBER_PS" Or _
sData_Type = "INTEGER" Then
If sData_Type = "NUMBER_PS" Then
sPhrase = sPhrase & Mid$(sField_Name,
1, 30) & " NUMBER"
Else
sPhrase = sPhrase & Mid$(sField_Name,
1, 30) & " " & sData_Type
End If
ElseIf sData_Type = "BOOLEAN" Then
sPhrase = sPhrase & Mid$(sField_Name,1, 30) _
& " NUMBER(1)"
ElseIf sData_Type = "VARCHAR2_MAX" Then
sPhrase = sPhrase & Mid$(sField_Name,1, 30) _
& " VARCHAR2(2000)"
ElseIf sData_Type = "DOUBLE" Then
sPhrase = sPhrase & Mid$(sField_Name, 1, _
30) & " " & "NUMBER(" & sField_Size & ")"
Else
sPhrase = sPhrase & Mid$(sField_Name, 1, _
30) & " " & sData_Type & "(" & sField_Size & ")"
End If
If bNullable = True Then
sPhrase = sPhrase & " NULL" & Chr(13) & Chr(10)
Else
sPhrase = sPhrase & " NOT NULL" & Chr(13) & Chr(10)
End If
sSQL = sSQL & sPhrase
Next
sSQL = sSQL & " )" & Chr(13) & Chr(10)
If sPCTFREE <> "" Then
sSQL = sSQL & " PCTFREE " & sPCTFREE & Chr(13) &
Chr(10)
End If
If sPCTUSED <> "" Then
sSQL = sSQL & " PCTUSED " & sPCTUSED & Chr(13) &
Chr(10)
End If
sSQL = sSQL & " TABLESPACE " & sTablespace &
Chr(13) & Chr(10)
sSQL = sSQL & " STORAGE " & Chr(13) & Chr(10)
sSQL = sSQL & " (" & Chr(13) & Chr(10)
If sINITIAL <> "" Then
sSQL = sSQL & " INITIAL " & sINITIAL & Chr(13) &
Chr(10)
End If
If sNEXT <> "" Then
sSQL = sSQL & " NEXT " & sNEXT & Chr(13) & Chr(10)
End If
If sMINEXTENTS <> "" Then
sSQL = sSQL & " MINEXTENTS " & sMINEXTENTS &
Chr(13) & Chr(10)
End If
If sMaxExtents <> "" Then
sSQL = sSQL & " MAXEXTENTS " & sMaxExtents &
Chr(13) & Chr(10)
End If
If sPCTINCREASE <> "" Then
sSQL = sSQL & " PCTINCREASE " & sPCTINCREASE &
Chr(13) & Chr(10)
End If
If sOPTIMAL <> "" Then
sSQL = sSQL & " OPTIMAL " & sOPTIMAL & Chr(13) &
Chr(10)
End If
sSQL = sSQL & " )" & Chr(13) & Chr(10)
createTableSQL = sSQL
Exit_createTableSQL:
Screen.MousePointer = vbDefault
Exit Function
createTableSQL_Error:
#If gnDebug Then
Stop
Resume
#End If
HandleError "createTableSQL", Err.Description,
Err.Number, gErrFormName
Resume Exit_createTableSQL
End Function
--------------------------------------------------------------------------------
Public Function ConvertOracleType(lValue As Long) As
String
On Error GoTo ConvertOracleType_Error
Dim sRetValue As String
Select Case lValue
Case dbBigInt
sRetValue = "NUMBER"
Case dbBinary
sRetValue = "LONG RAW"
Case dbBoolean
sRetValue = "BOOLEAN"
Case dbByte
sRetValue = "NUMBER"
Case dbChar
sRetValue = "CHAR"
Case dbCurrency
sRetValue = "NUMBER_PS"
Case dbDate
sRetValue = "DATE"
Case dbDecimal
sRetValue = "NUMBER_PS"
Case dbDouble
sRetValue = "DOUBLE"
Case dbFloat
sRetValue = "FLOAT"
Case dbGUID
sRetValue = "NUMBER_PS"
Case dbInteger
sRetValue = "NUMBER"
Case dbLong
sRetValue = "NUMBER"
Case dbLongBinary
sRetValue = "LONG RAW"
Case dbMemo
sRetValue = "VARCHAR2_MAX"
Case dbNumeric
sRetValue = "NUMBER_PS"
Case dbSingle
sRetValue = "NUMBER"
Case dbText
sRetValue = "VARCHAR2"
Case dbTime
sRetValue = "DATE"
Case dbTimeStamp
sRetValue = "DATE"
Case dbVarBinary
sRetValue = "RAW"
Case Else
sRetValue = "Unknown Type"
End Select
ConvertOracleType = sRetValue
Exit_ConvertOracleType:
Exit Function
ConvertOracleType_Error:
#If gnDebug Then
Stop
Resume
#End If
HandleError "ConvertOracleType", Err.Description,
Err.Number, gErrFormName
Resume Exit_ConvertOracleType
End Function