[AccessD] Code to auto-load an ORACLE schema

As usual reading someone else's code on web helped (with creating fields
and properties)

This code is a long way from a complete schema implementation engine. A
long, long way.but thanks for a little bit of praise after a tough week Jim.

;)
On May 18, 2012 10:01 PM, "Jim Lawrence" <accessd at shaw.ca> wrote:

> Good job there, Benson.
>
> Jim
>
> -----Original Message-----
> From: accessd-bounces at databaseadvisors.com
> [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Benson, William
> (GE Global Research, consultant)
> Sent: Friday, May 18, 2012 6:55 PM
> To: Access Developers discussion and problem solving
> Subject: Re: [AccessD] Code to auto-load an ORACLE schema
>
> Resolved the error. I needed to append the field to the fields collection
> and then I also benefited from assigning the property values as I created
> them and definitely did need to append the properties. I guess order of
> events is important.
>
> Sub CreateTableAndFields()
> Dim XL As Excel.Application
> Dim R As Excel.Range
> Dim WS As Excel.Worksheet
> Dim WB As Excel.Workbook
> Dim rBegin As Range
> Dim rEnd As Range
> Dim Cell As Excel.Range
> Dim D As DAO.Database
> Dim T As DAO.TableDef
> Dim F As DAO.Field
> Dim Ar()
> Dim P As DAO.Property
> Dim sLastTable As String
> Dim ub As Long
> Set XL = MyXL
> Set D = CurrentDb
> Set WB = XL.ActiveWorkbook
> Set WS = WB.ActiveSheet
> Set R = WB.Names("MyFields").RefersToRange
> Set rBegin = R.Cells(1, 1).Offset(1, 0)
> Set rEnd = WS.Cells(WS.Rows.Count, 1).End(xlUp)
> If rEnd.Row > R.Cells(1, 1).Row Then
>    'There is data
>    Set rBegin = R.Cells(1, 1).Offset(1, 0)
>    Set rEnd = WS.Cells(WS.Rows.Count, 1).End(xlUp)
>    For Each Cell In XL.Range(rBegin, rEnd).Cells
>        If sLastTable <> XL.Trim(Cell) Then
>            '1 =Table Name (don't need this but may as well)
>            '2 = Field Name
>            '3 = Type
>            '4 = Size
>            '5 = Decimals
>            '6 = ValidationRule
>            '7 = Required
>
>            ReDim Ar(1 To 7, 1 To 1)
>            On Error Resume Next
>            DoCmd.DeleteObject acTable, XL.Trim(Cell)
>            On Error GoTo 0
>            Set T = D.CreateTableDef(Name:=XL.Trim(Cell))
>            ub = 1
>        Else
>            ub = UBound(Ar, 2) + 1
>            ReDim Preserve Ar(1 To 7, 1 To ub)
>        End If
>        Ar(1, ub) = XL.Trim(Cell) 'Table Name
>        Ar(2, ub) = XL.Trim(Cell.Offset(0, 1)) 'Field Name
>        Ar(3, ub) = CLng(Cell.Offset(0, 2)) ' Type
>        Ar(4, ub) = CLng(Cell.Offset(0, 3)) ' Size
>        If Len(XL.Trim(Cell.Offset(0, 4))) > 0 Then
>            Ar(5, ub) = CLng(Cell.Offset(0, 4)) 'Decimals
>        End If
>        If Len(XL.Trim(Cell.Offset(0, 5))) > 0 Then
>            Ar(6, ub) = XL.Trim(Cell.Offset(0, 5)) 'ValidationRule
>        End If
>        If XL.Trim(Cell.Offset(0, 6)) = "NOT NULL" Then
>            Ar(7, ub) = True 'Required
>        Else
>            Ar(7, ub) = False
>        End If
>        Set F = T.CreateField(Ar(2, ub), Ar(3, ub), Ar(4, ub))
>        T.Fields.Append F
>        F.Required = Ar(7, ub)
>        If CStr(Ar(6, ub)) <> "" Then
>            F.ValidationRule = CStr(Ar(6, ub))
>        End If
>        If CStr(Ar(5, ub)) <> "" Then
>            Set P = F.CreateProperty(Name:="DecimalPlaces", Type:=2,
> Value:=Ar(5, ub))
>            'P.Value = Ar(5, ub)
>            F.Properties.Append P
>        End If
>        If CLng(Ar(3, ub)) = 8 And CLng(Ar(4, ub)) = 8 Then
>
>            Set P = F.CreateProperty(Name:="Format", Type:=10,
> Value:="General Date")
>        '    P.Value = "General Date"
>            F.Properties.Append P
>        End If
>        If ub = 1 Then
>            D.TableDefs.Append T
> '            D.TableDefs.Refresh
>        End If
>
>        sLastTable = Cell
>    Next
> End If
> Application.RefreshDatabaseWindow
>
> End Sub
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>