Newbie: How to copy Table structure?
There's no easy way to do this and retain all of the source table's
properties, indexes, etc. except write alot of code. I just had this exact
same issue and after alot of research found that there was no easy way. I
ended up with the following function that worked well for me:
'=====================================================================
Public Function CopyTblStruct _
(ByRef vSrcDB As Database, _
ByRef vTgtDB As Database, _
ByVal vSrcTbl$, _
ByVal vTgtTbl$) As Boolean
'returns true if vSrcTbl table structure (including properties and indexes)
is copied
' to vTgtTbl (no data is copied)
' false otherwise (MsgBox displayed on error)
Dim pErr&
Dim sTB As DAO.TableDef, sFld As DAO.Field 'source
Dim sProp As DAO.Property, sIdx As DAO.Index 'source
Dim tTB As DAO.TableDef, tFld As DAO.Field 'target
Dim tProp As DAO.Property, tIdx As DAO.Index 'target
On Error GoTo HandleError
If vSrcDB Is Nothing Then Exit Function
If vTgtDB Is Nothing Then Exit Function
On Error Resume Next
Set tTB = vTgtDB.TableDefs(vTgtTbl)
On Error GoTo HandleError
If Not tTB Is Nothing Then Exit Function 'table already exists
'clone the Tabledef
Set sTB = vSrcDB.TableDefs(vSrcTbl)
Set tTB = vTgtDB.CreateTableDef(vTgtTbl)
'set pre-append Tabledef properties
tTB.Properties("Attributes") = sTB.Properties("Attributes")
tTB.Properties("SourceTableName") = sTB.Properties("SourceTableName")
'copy the fields
For Each sFld In sTB.Fields
With sFld
Set tFld = tTB.CreateField(.Name, .Properties("Type"))
'copy the field properties
For Each sProp In sFld.Properties
With sProp
On Error Resume Next
tFld.Properties(.Name) = sFld.Properties(.Name)
pErr = Err
On Error GoTo HandleError
If pErr = 3270 Then 'property does not exist, create it
Set tProp = tFld.CreateProperty(.Name, .Type, .Value)
On Error Resume Next
tFld.Properties.Append tProp
On Error GoTo HandleError
End If
End With
Next
End With
tTB.Fields.Append tFld 'append the field
Next
vTgtDB.TableDefs.Append tTB 'append the new table
'copy user-define Access properties (like "Description"); must be done
'after table is appended
For Each sFld In sTB.Fields
With sFld
Set tFld = tTB.Fields(.Name)
For Each sProp In sFld.Properties
With sProp
On Error Resume Next 'some may already exist
Set tProp = tFld.CreateProperty(.Name, .Type, .Value)
tFld.Properties.Append tProp
On Error GoTo HandleError
End With
Next
End With
Next
'copy Tabledef properties
For Each sProp In sTB.Properties
With sProp
On Error Resume Next
tTB.Properties(.Name).Value = sTB.Properties(.Name).Value
pErr = Err
On Error GoTo HandleError
If pErr = 3270 Then 'property does not exist, create it
Set tProp = tTB.CreateProperty(.Name, _
sTB.Properties(.Name).Type, _
sTB.Properties(.Name).Value)
On Error Resume Next
tTB.Properties.Append tProp
On Error GoTo HandleError
End If
End With
Next
'copy the indexes
For Each sIdx In sTB.Indexes
With sIdx
'Don't copy "Foreign" indexes. These indexes are created
'and maintained by Access to support relationships with
'enforced referential integrity.
If Not .Foreign Then
Set tIdx = sTB.CreateIndex(.Name)
'set the pre-append index properties
tIdx.Properties("Primary") = .Properties("Primary")
tIdx.Properties("Unique") = .Properties("Unique")
tIdx.Properties("Clustered") = .Properties("Clustered")
tIdx.Properties("Required") = .Properties("Required")
tIdx.Properties("IgnoreNulls") = .Properties("IgnoreNulls")
'copy the index fields
For Each sFld In sIdx.Fields
With sFld
Set tFld = tIdx.CreateField(.Name)
'copy the index field properties
For Each sProp In .Properties
With sProp
On Error Resume Next
tFld.Properties(.Name).Value =
sFld.Properties(.Name).Value
pErr = Err
On Error GoTo HandleError
If pErr = 3270 Then 'property does not
exist, create it
Set tProp = tTB.CreateProperty(.Name, _
sTB.Properties(.Name).Type, _
sTB.Properties(.Name).Value)
tTB.Properties.Append tProp
End If
End With
Next
tIdx.Fields.Append tFld 'append the index field
End With
Next
tTB.Indexes.Append tIdx 'append the new index
'set the index properties
For Each sProp In .Properties
With sProp
On Error Resume Next
tIdx.Properties(.Name) = sIdx.Properties(.Name)
pErr = Err
On Error GoTo HandleError
If pErr = 3270 Then 'property does not exist, create
it
Set tProp = tTB.CreateProperty(.Name, _
sTB.Properties(.Name).Type, _
sTB.Properties(.Name).Value)
tTB.Properties.Append tProp
End If
End With
Next
End If
End With
Next
CopyTblStruct = True
Exit Function
HandleError:
' Put an error MsgBox here -- mine was a call to our Tools DLL which you
won't have.
Exit Function
End Function
'==============================================================
Ed Lyons
Quote:
> Is there any way to Clone a table form one database to another database?
> I mean, to capture the structure without the data. I know you can make
the
> structure
> with code, but I have a database with 10 tables in it. I think there must
> be a way to
> do this without writing all of that code!
> Thanks,
> Magic
