I work from a table created mainly from the documenter. The table and fields
are
ztblTempStructu re
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_E rr
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(strThisDBN ame, Len(strThisDBNa me) -
Len(Dir(strThis DBName)))
strTempDBName = strFolder & "PrdRptTemp.MDB "
On Error Resume Next
Kill strTempDBName 'if the old one exists, delete it
On Error GoTo BldTempTables_E rr
'Create the new empty database
Set dbTemp = CreateDatabase( strTempDBName, dbLangGeneral)
Set rsStruct = dbThis.OpenReco rdset("Select TableName, FieldName,
FieldType, FieldSize, Indexed " & _
"FROM ztblTempStructu re ORDER BY TableName")
With rsStruct
If Not .EOF Then
.MoveFirst
Do Until .EOF
strTableName = !TableName
Set tdf = dbTemp.CreateTa bleDef(strTable Name)
Do Until !TableName <> strTableName
Select Case !FieldType
Case dbText
Set fld = tdf.CreateField (!FieldName,
!FieldType, !FieldSize)
fld.AllowZeroLe ngth = True
Case Else
Set fld = tdf.CreateField (!FieldName,
!FieldType)
End Select
tdf.Fields.Appe nd fld
tdf.Fields.Refr esh
.MoveNext
If .EOF Then
Exit Do
End If
Loop
dbTemp.TableDef s.Append tdf
dbTemp.TableDef s.Refresh
Loop
End If
.Close
End With
'Create the indexes
Set rsStruct = dbThis.OpenReco rdset("Select TableName, FieldName,
FieldType, Indexed, PrimaryKey " & _
"FROM ztblTempStructu re WHERE Indexed = -1 OR PrimaryKey = -1
ORDER BY TableName")
With rsStruct
.MoveFirst
If Not .EOF Then
.MoveFirst
Do Until .EOF
Set tdf = dbTemp.TableDef s(!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.Appe nd fld
'set up the primary key field.
If !PrimaryKey = True Then
ndx.Primary = True
End If
tdf.Indexes.App end ndx
tdf.Indexes.Ref resh
.MoveNext
If .EOF Then
Exit Do
End If
Loop
Loop
End If
.Close
End With
Set rsStruct = dbThis.OpenReco rdset("Select Distinct TableName From
ztblTempStructu re")
'relink the tables
With rsStruct
.MoveFirst
Do Until .EOF
DoCmd.DeleteObj ect acTable, !TableName
DoCmd.TransferD atabase acLink, "Microsoft Access",
strTempDBName, acTable, !TableName, !TableName
dbThis.TableDef s.Refresh
.MoveNext
Loop
.Close
End With
Set rsStruct = Nothing
Set dbThis = Nothing
Set dbTemp = Nothing
BldTempTables = True
BldTempTables_E xit:
Exit Function
BldTempTables_E rr:
Select Case Err
Case Else
strErrMsg = strErrMsg & "Error #: " & Format$(Err.Num ber) &
vbCrLf
strErrMsg = strErrMsg & "Error Description: " & Err.Description
MsgBox strErrMsg, vbInformation, "BldTempTab les"
BldTempTables = False
Resume BldTempTables_E xit
End Select
End Function
--
Duane Hookom
MS Access MVP
"PC Datasheet" <no****@nospam. spam> wrote in message
news:_O******** *********@newsr ead1.news.atl.e arthlink.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
