By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
435,473 Members | 3,292 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,473 IT Pros & Developers. It's quick & easy.

Way to create multiple tables on the fly

P: n/a
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...
Jul 14 '08 #1
Share this Question
Share on Google+
3 Replies


P: n/a
DeanL <de*************@yahoo.comwrote in
news:65c1529d-15e1-42a9-86ef-
46**********@m36g2000hse.googlegroups.co
m:
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...
If the table was generated from Access, I'd just open it in a
DAO.recordset, and loop on the table name, either adding the tables
and their fields to the relevant collection or building a SQL Create
Table atatement.

There may be other ways.
--
Bob Quintal

PA is y I've altered my email address.
** Posted from http://www.teranews.com **
Jul 15 '08 #2

P: n/a
DeanL 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...
Here's an example from help using "CreateTableDef"

Sub NewTable()
Dim dbs As Database, tdf As TableDef, fld As Field

' Return reference to current database.
Set dbs = CurrentDb
' Return TableDef object variable that points to new table.
Set tdf = dbs.CreateTableDef("Contacts")
' Define new field in table.
Set fld = tdf.CreateField("ContactName", dbText, 40)
' Append Field object to Fields collection of TableDef object.
tdf.Fields.Append fld
tdf.Fields.Refresh
' Append TableDef object to TableDefs collection of database.

dbs.TableDefs.Append tdf
dbs.TableDefs.Refresh
Set dbs = Nothing
End Sub
Also, you should look at the "Create Table" help topic. You can create
the table and fields via SQL
Jul 15 '08 #3

P: n/a
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. abfTempTableNames
TempTableName - Text (PK)

2. abfTempTableFieldNames
TempTableName - Text (PK)
FieldName - Text (PK)
FieldType - Long
FieldSize - Integer
AutoNum - Y/N

3. abfTempTableIndexes
TempIndexID - AutoNum (PK)
TempTableName - Text
Fields - Text (Format = +FieldName for single field index
or +FieldName1+FieldName2+FieldName3 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.OpenRecordset("abfTempTableNames", dbOpenSnapshot)

'get current path and set DB name from constant
strNewDB = Mid(CurDB.Name, 1, Len(CurDB.Name) - 4) & "_tmp" & right(CurDB.Name,
4)

' Get default Workspace.
Set BFws = DBEngine.Workspaces(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.CreateDatabase(strNewDB, dbLangGeneral)

'create tables
With rstTbls
If Not (.BOF And .EOF) Then
'set status line
varRet = SysCmd(acSysCmdSetStatus, "Now Creating Temporary File.")
Do Until .EOF
'add tabledef
Set tdf = Bfdb.CreateTableDef(!TempTableName)

'add fields
strSQL = "SELECT * FROM abfTempTableFieldNames WHERE
(((TempTableName)='" & !TempTableName & "'));"
Set rstFlds = CurDB.OpenRecordset(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.Attributes = dbAutoIncrField
End If
tdf.Fields.Append fldNew
.MoveNext
Loop
End If
.Close
End With
Set rstFlds = Nothing

'add indexes
strSQL = "SELECT * FROM abfTempTableIndexes WHERE
(((TempTableName)='" & !TempTableName & "'));"
Set rstInds = CurDB.OpenRecordset(strSQL, dbOpenSnapshot)

With rstInds
If Not (.BOF And .EOF) Then
Do Until .EOF
'create index
Set indNew = tdf.CreateIndex(!Name)
indNew.IgnoreNulls = !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.Append
indNew.CreateField(strNewField)
Else
strNewField = right(strFields, Len(strFields) -
1)
strFields = ""
indNew.Fields.Append
indNew.CreateField(strNewField)
End If
Loop
tdf.Indexes.Append 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.CreateTableDef(tdf.Name)
tdfNew.Connect = ";Database=" & Bfdb.Name
tdfNew.SourceTableName = tdf.Name
CurDB.TableDefs.Append tdfNew
tdfNew.RefreshLink
Else
'connect here
Set tdfNew = CurDB.CreateTableDef(tdf.Name)
tdfNew.Connect = ";Database=" & Bfdb.Name
tdfNew.SourceTableName = tdf.Name
CurDB.TableDefs.Append tdfNew
tdfNew.RefreshLink
End If

.MoveNext
Loop
End If
End With

'success
fCreateTempDB = True

OutHere:
varRet = SysCmd(acSysCmdClearStatus)
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,
"fCreateTempDB"
fCreateTempDB = False
Resume OutHere
End Select

End Function

'************************************************* ********************
Function fCheckLink(strTableName 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
Jul 16 '08 #4

This discussion thread is closed

Replies have been disabled for this discussion.