VB icon

Copy a database table

Email
Submitted on: 1/1/2015 9:00:00 AM
By: Newsgroup Posting (from psc cd)  
Level: Not Given
User Rating: By 6 Users
Compatibility: VB 4.0 (16-bit), VB 4.0 (32-bit), VB 5.0, VB 6.0
Views: 940
 
     How to copy a database table. This may require some tweaking.... "Bill Pearson"
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Copy a database table
' Description:How to copy a database table. This may require some tweaking....
 "Bill Pearson" <billp@dnai.com>
' By: Newsgroup Posting (from psc cd)
'**************************************

Private Sub Form_Load()
Dim dbFrom As Database
Dim dbToAs Database
Set dbFrom = workspaces(0).opendatabase("c:\vb4\biblio.mdb")
Set dbTo = workspaces(0).opendatabase("c:\vb4\biblio.mdb")
db_Copy_Tabledef dbFrom, dbTo, "Authors", "CopyOfAuthors"
dbFrom.Close
dbTo.Close
End Sub
Public Function db_Copy_Tabledef(dbFrom As Database, dbTo As Database,
TableNameFrom As String, TableNameTo As String) As Boolean
Dim tdFromAs TableDef
Dim tdTo As TableDef
Dim fldFrom As Field
Dim fldToAs Field
Dim ndxFrom As Index
Dim ndxToAs Index
Dim FunctionName As String
Dim FoundAs Boolean
On Error Resume Next
For Each tdFrom In dbFrom.TableDefs
'-----------------------------
'Loop until find the table def
'-----------------------------
If LCase$(tdFrom.Name) = LCase$(TableNameFrom) Then
 
Found = True
 '----------------------
 'Create Table defintion
 '----------------------
Set tdTo = dbTo.CreateTableDef(TableNameTo)
 '------------------------------
 'Copy each field and attributes
 '------------------------------
For Each fldFrom In dbFrom.TableDefs(tdFrom.Name).Fields
Set fldTo = tdTo.CreateField(fldFrom.Name)
fldTo.Type = fldFrom.Type
fldTo.DefaultValue = fldFrom.DefaultValue
fldTo.Required = fldFrom.Required
Select Case fldFrom.Type
 Case dbText
 fldTo.Size = fldFrom.Size
 fldTo.Attributes = fldFrom.Attributes
 fldTo.AllowZeroLength = fldTo.AllowZeroLength
 Case dbMemo
 fldTo.AllowZeroLength = fldTo.AllowZeroLength
 Case Else
End Select
tdTo.Fields.Append fldTo
If Err.Number > 0 Then
 MsgBox "Error adding field to table " & TableNameTo &
".", vbCritical, FunctionName
 Exit Function
End If
Next
 '-----------------------
 'Copy Index defintion(s)
 '-----------------------
For Each ndxFrom In dbFrom.TableDefs(tdFrom.Name).Indexes
Set ndxTo = tdTo.CreateIndex(ndxFrom.Name)
ndxTo.Required = ndxFrom.Required
ndxTo.IgnoreNulls = ndxFrom.IgnoreNulls
ndxTo.Primary = ndxFrom.Primary
ndxTo.Clustered = ndxFrom.Clustered
ndxTo.Unique = ndxFrom.Unique
 '---------------------
 'Copy each index field
 '---------------------
For Each fldFrom In
dbFrom.TableDefs(tdFrom.Name).Indexes(ndxFrom.Name).Fields
Set fldTo = ndxTo.CreateField(fldFrom.Name)
ndxTo.Fields.Append fldTo
If Err.Number > 0 Then
 MsgBox "Error adding field to index in table " &
TableNameTo & ".", vbCritical, FunctionName
 Exit Function
End If
Next
tdTo.Indexes.Append ndxTo
If Err.Number > 0 Then
 MsgBox "Error adding index to table " & TableNameTo &
".", vbCritical, FunctionName
 Exit Function
End If
Next
dbTo.TableDefs.Append tdTo
If Err.Number > 0 Then
 MsgBox "Error adding table " & TableNameTo & ".", vbCritical,
FunctionName
 Exit Function
End If
Exit For
End If
Next
If Found Then
db_Copy_Tabledef = True
Else
MsgBox "Table " & TableNameFrom & " not found.", vbExclamation,
FunctionName
End If
On Error GoTo 0
End Function


Other 14 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Not Given category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.