On Mon, 14 Jul 2008 11:42:21 -0700 (PDT), DeanL <de************ *@yahoo.com>
wrote:
>Hi guys,
Does anyone know of a way to create multiple tables using information
stored in one table? I have a table with 4 columns (TableName,
ColumnName, DataType, DataSize) and wanted to know if there is a way
to use the information in this table to create the many tables that
are listed in the source table instead of creating each table
individually ?
Many thanks for any help you can offer.
Dean...
I use 3 tables to create a database containing temporary tables I sometimes use
for reporting. You may be able to use parts of the code below to achieve what
you want.
1. abfTempTableNam es
TempTableName - Text (PK)
2. abfTempTableFie ldNames
TempTableName - Text (PK)
FieldName - Text (PK)
FieldType - Long
FieldSize - Integer
AutoNum - Y/N
3. abfTempTableInd exes
TempIndexID - AutoNum (PK)
TempTableName - Text
Fields - Text (Format = +FieldName for single field index
or +FieldName1+Fie ldName2+FieldNa me3 for multi field index)
IgnoreNulls - Y/N
Name - Text
Primary - Y/N
Required - Y/N
Unique - Y/N
'************** *************** *************** *************** **********
Function fCreateTempDB() As Boolean
Dim BFws As Workspace
Dim Bfdb As Database
Dim CurDB As Database
Dim prpLoop As Property
Dim strNewDB As String
Dim rstTbls As Recordset
Dim rstFlds As Recordset
Dim rstInds As Recordset
Dim tdf As TableDef
Dim tdfNew As TableDef
Dim strSQL As String
Dim fldNew As Field
Dim indNew As Index
Dim varRet As Variant
Dim strFields As String
Dim x1 As Integer
Dim x2 As Integer
Dim strNewField As String
On Error GoTo HandleIt
'get table/field definitions
Set CurDB = DBEngine(0)(0)
Set rstTbls = CurDB.OpenRecor dset("abfTempTa bleNames", dbOpenSnapshot)
'get current path and set DB name from constant
strNewDB = Mid(CurDB.Name, 1, Len(CurDB.Name) - 4) & "_tmp" & right(CurDB.Nam e,
4)
' Get default Workspace.
Set BFws = DBEngine.Worksp aces(0)
' Make sure there isn't already a file with the name of
' the new database.
If Dir(strNewDB) <"" Then Kill strNewDB
' Create a new database
Set Bfdb = BFws.CreateData base(strNewDB, dbLangGeneral)
'create tables
With rstTbls
If Not (.BOF And .EOF) Then
'set status line
varRet = SysCmd(acSysCmd SetStatus, "Now Creating Temporary File.")
Do Until .EOF
'add tabledef
Set tdf = Bfdb.CreateTabl eDef(!TempTable Name)
'add fields
strSQL = "SELECT * FROM abfTempTableFie ldNames WHERE
(((TempTableNam e)='" & !TempTableName & "'));"
Set rstFlds = CurDB.OpenRecor dset(strSQL, dbOpenSnapshot)
With rstFlds
If Not (.BOF And .EOF) Then
Do Until .EOF
Set fldNew = tdf.CreateField (!FieldName, !FieldType,
!FieldSize)
If !AutoNum = True Then
fldNew.Attribut es = dbAutoIncrField
End If
tdf.Fields.Appe nd fldNew
.MoveNext
Loop
End If
.Close
End With
Set rstFlds = Nothing
'add indexes
strSQL = "SELECT * FROM abfTempTableInd exes WHERE
(((TempTableNam e)='" & !TempTableName & "'));"
Set rstInds = CurDB.OpenRecor dset(strSQL, dbOpenSnapshot)
With rstInds
If Not (.BOF And .EOF) Then
Do Until .EOF
'create index
Set indNew = tdf.CreateIndex (!Name)
indNew.IgnoreNu lls = !IgnoreNulls
indNew.Primary = !Primary
indNew.Required = !Required
indNew.Unique = !Unique
'parse Fields property and strip individual field names
'append each field to index fields collection
strFields = rstInds!Fields
Do Until InStr(1, strFields, Chr(43)) = 0
x1 = InStr(1, strFields, Chr(43))
x2 = InStr(2, strFields, Chr(43))
If x2 <0 Then
strNewField = Mid(strFields, x1 + 1, ((x2 - 1) -
(x1 + 1)))
strFields = right(strFields , Len(strFields) -
(x2 - 1))
indNew.Fields.A ppend
indNew.CreateFi eld(strNewField )
Else
strNewField = right(strFields , Len(strFields) -
1)
strFields = ""
indNew.Fields.A ppend
indNew.CreateFi eld(strNewField )
End If
Loop
tdf.Indexes.App end indNew
.MoveNext
Loop
End If
.Close
End With
Set rstInds = Nothing
Bfdb.TableDefs. Append tdf
'link table
CurDB.TableDefs .Refresh
If (fCheckLink(tdf .Name)) Then 'already linked so delete and
refresh
Set tdfNew = CurDB.TableDefs (tdf.Name)
CurDB.TableDefs .Delete tdfNew.Name
CurDB.TableDefs .Refresh
Set tdfNew = CurDB.CreateTab leDef(tdf.Name)
tdfNew.Connect = ";Database= " & Bfdb.Name
tdfNew.SourceTa bleName = tdf.Name
CurDB.TableDefs .Append tdfNew
tdfNew.RefreshL ink
Else
'connect here
Set tdfNew = CurDB.CreateTab leDef(tdf.Name)
tdfNew.Connect = ";Database= " & Bfdb.Name
tdfNew.SourceTa bleName = tdf.Name
CurDB.TableDefs .Append tdfNew
tdfNew.RefreshL ink
End If
.MoveNext
Loop
End If
End With
'success
fCreateTempDB = True
OutHere:
varRet = SysCmd(acSysCmd ClearStatus)
Bfdb.Close
Set Bfdb = Nothing
Set BFws = Nothing
Set CurDB = Nothing
Exit Function
HandleIt:
Select Case Err
Case 0, 91
Resume Next
Case 75
fCreateTempDB = False
Resume OutHere
Case Else
Beep
MsgBox Err & " " & Err.Description , vbCritical + vbOKOnly,
"fCreateTem pDB"
fCreateTempDB = False
Resume OutHere
End Select
End Function
'************** *************** *************** *************** **********
Function fCheckLink(strT ableName As String) As Boolean
'check if passed table name exists in DB
Dim i As Integer
Dim Bfdb As Database
On Error GoTo HandleIt
Set Bfdb = DBEngine(0)(0)
Bfdb.TableDefs. Refresh
fCheckLink = False
For i = 0 To Bfdb.TableDefs. Count - 1
If Bfdb.TableDefs( i).Name = strTableName Then
fCheckLink = True
Exit For
End If
Next i
OutHere:
Set Bfdb = Nothing
Exit Function
HandleIt:
Select Case Err
Case Else
fCheckLink = False
Resume OutHere
End Select
End Function
'************** *************** *************** *************** **********
Wayne Gillespie
Gosford NSW Australia
