by Payman Motamedi (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 25th April 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Creating a blank DB by reading its structure (Tables, fields, Data Type) from a table in another DB
VBcoders
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
No comments have been posted about Creating a blank DB by reading its structure (Tables, fields, Data Type) from a table in another DB. Why not be the first to post a comment about Creating a blank DB by reading its structure (Tables, fields, Data Type) from a table in another DB.
