I work from a table created mainly from the documenter. The table and fields
are
ztblTempStructure
TableName
FieldName
FieldType
FieldSize
Indexed
PrimaryKey
And the code is:
Function BldTempTables() As Boolean
'================================================= ===========
' Programmer: Duane Hookom
' Revision #:
' Called From:
' Date: 7/5/01
' Parameters:
'================================================= ===========
On Error GoTo BldTempTables_Err
Dim strErrMsg As String 'For Error Handling
'Dim the objects
Dim dbThis As DAO.Database
Dim dbTemp As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim ndx As DAO.Index
Dim rsStruct As DAO.Recordset 'the struct table
'Dim the variables
Dim strFolder As String 'the folder this application is located
in
Dim strThisDBName As String 'the name of this MDB
Dim strTempDBName As String 'The name of the temp mdb
Dim strTableName As String 'the table name
Set dbThis = CurrentDb
strThisDBName = dbThis.Name
strFolder = Left(strThisDBName, Len(strThisDBName) -
Len(Dir(strThisDBName)))
strTempDBName = strFolder & "PrdRptTemp.MDB"
On Error Resume Next
Kill strTempDBName 'if the old one exists, delete it
On Error GoTo BldTempTables_Err
'Create the new empty database
Set dbTemp = CreateDatabase(strTempDBName, dbLangGeneral)
Set rsStruct = dbThis.OpenRecordset("Select TableName, FieldName,
FieldType, FieldSize, Indexed " & _
"FROM ztblTempStructure ORDER BY TableName")
With rsStruct
If Not .EOF Then
.MoveFirst
Do Until .EOF
strTableName = !TableName
Set tdf = dbTemp.CreateTableDef(strTableName)
Do Until !TableName <> strTableName
Select Case !FieldType
Case dbText
Set fld = tdf.CreateField(!FieldName,
!FieldType, !FieldSize)
fld.AllowZeroLength = True
Case Else
Set fld = tdf.CreateField(!FieldName,
!FieldType)
End Select
tdf.Fields.Append fld
tdf.Fields.Refresh
.MoveNext
If .EOF Then
Exit Do
End If
Loop
dbTemp.TableDefs.Append tdf
dbTemp.TableDefs.Refresh
Loop
End If
.Close
End With
'Create the indexes
Set rsStruct = dbThis.OpenRecordset("Select TableName, FieldName,
FieldType, Indexed, PrimaryKey " & _
"FROM ztblTempStructure WHERE Indexed = -1 OR PrimaryKey = -1
ORDER BY TableName")
With rsStruct
.MoveFirst
If Not .EOF Then
.MoveFirst
Do Until .EOF
Set tdf = dbTemp.TableDefs(!TableName)
'Debug.Print tdf.Name
strTableName = !TableName
Do Until !TableName <> strTableName
'Debug.Print "-" & !FieldName
Set ndx = tdf.CreateIndex(!FieldName)
Set fld = ndx.CreateField(!FieldName, !FieldType)
ndx.Fields.Append fld
'set up the primary key field.
If !PrimaryKey = True Then
ndx.Primary = True
End If
tdf.Indexes.Append ndx
tdf.Indexes.Refresh
.MoveNext
If .EOF Then
Exit Do
End If
Loop
Loop
End If
.Close
End With
Set rsStruct = dbThis.OpenRecordset("Select Distinct TableName From
ztblTempStructure")
'relink the tables
With rsStruct
.MoveFirst
Do Until .EOF
DoCmd.DeleteObject acTable, !TableName
DoCmd.TransferDatabase acLink, "Microsoft Access",
strTempDBName, acTable, !TableName, !TableName
dbThis.TableDefs.Refresh
.MoveNext
Loop
.Close
End With
Set rsStruct = Nothing
Set dbThis = Nothing
Set dbTemp = Nothing
BldTempTables = True
BldTempTables_Exit:
Exit Function
BldTempTables_Err:
Select Case Err
Case Else
strErrMsg = strErrMsg & "Error #: " & Format$(Err.Number) &
vbCrLf
strErrMsg = strErrMsg & "Error Description: " & Err.Description
MsgBox strErrMsg, vbInformation, "BldTempTables"
BldTempTables = False
Resume BldTempTables_Exit
End Select
End Function
--
Duane Hookom
MS Access MVP
"PC Datasheet" <no****@nospam.spam> wrote in message
news:_O*****************@newsread1.news.atl.earthl ink.net...
Using code in MyDateBase I create a new database named MyNewDatabase. Now
I need to import (or export) using code in MyDatabase tables in another
external database named MyData to MyNewDatabase. Is there a way to do it?
What is the code?
Thanks,
Steve
