• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Creating a blank DB by reading its structure (Tables, fields, Data Type) from a table in another DB

Creating a blank DB by reading its structure (Tables, fields, Data Type) from a table in another DB

Creating a blank DB by reading its structure (Tables, fields, Data Type) from a table in another DB

Rate Creating a blank DB by reading its structure (Tables, fields, Data Type) from a table in another DB

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Dim rsTable, rsField As dao.Recordset
Dim str1, str2 As String, db1, db2 As dao.Database
Dim int1 As Integer, fld As Field, tdf As dao.TableDef

CreateDB = False

On Error GoTo CreateDB_Error
Set db1 = OpenDatabase(G_RefDB)
Set rsTable = db1.OpenRecordset("Select Distinct TableName from tblTableFields")

If Dir(dbName) <> "" Then Kill dbName

Set db2 = CreateDatabase(dbName, dbLangGeneral)

rsTable.MoveFirst
Do Until rsTable.EOF
    On Error Resume Next
    db2.TableDefs.Delete rsTable!TableName
    On Error GoTo 0
    Set tdf = db2.CreateTableDef(rsTable!TableName)
    Set rsField = db1.OpenRecordset("Select * from tblTableFields where TableName = '" & rsTable!TableName & "'")
    rsField.MoveLast
    rsField.MoveFirst
    Do Until rsField.EOF
    Select Case rsField!Type
        Case "dbText"
            Set fld = tdf.CreateField(rsField!FieldName, dbText)
        Case "dbInteger"
            Set fld = tdf.CreateField(rsField!FieldName, dbInteger)
        Case "dbLong"
            Set fld = tdf.CreateField(rsField!FieldName, dbLong)
        Case "dbBoolean"
            Set fld = tdf.CreateField(rsField!FieldName, dbBoolean)
        Case "dbByte"
            Set fld = tdf.CreateField(rsField!FieldName, dbByte)
        Case "dbSingle"
            Set fld = tdf.CreateField(rsField!FieldName, dbSingle)
        Case "dbDate"
            Set fld = tdf.CreateField(rsField!FieldName, dbDate)
        Case "dbDouble"
            Set fld = tdf.CreateField(rsField!FieldName, dbDouble)
        Case "dbLongBinary"
            Set fld = tdf.CreateField(rsField!FieldName, dbLongBinary)
        Case "dbMemo"
            Set fld = tdf.CreateField(rsField!FieldName, dbMemo)
    End Select
        'Set fld = tdf.CreateField(rsField!FieldName, rsField!Type)
        If Not IsNull(rsField!Size) Then fld.Size = rsField!Size
        If Not IsNull(rsField!DefaultValue) Then fld.DefaultValue = rsField!DefaultValue
        If rsField!Type = "dbText" Then fld.AllowZeroLength = rsField!AllowZero
    tdf.Fields.Append fld
    rsField.MoveNext
    Loop
 db2.TableDefs.Append tdf
 db2.TableDefs.Refresh
rsTable.MoveNext
On Error Resume Next

On Error GoTo 0
Loop
rsTable.Close
rsField.Close
db1.Close
db2.Close
Set rsTable = Nothing
Set rsField = Nothing
Set db1 = Nothing
Set db2 = Nothing
CreateDB = True
Exit Function
CreateDB_Error:
MsgBox "The error: " & Err.Description & "has happened"
End Function