Solved

Copy table from one database to another

Posted on 2002-06-08
2
189 Views
Last Modified: 2012-06-28
Hi
I need to open, by code, two databases, via JET or ADO, and copy 4 tables from the first one to the another one.
It is possible to do this with a command line like "database.copy tblproducts to database2"???
....don't know...just guessing...

Thanks!!
0
Comment
Question by:mltolun
2 Comments
 
LVL 69

Accepted Solution

by:
Éric Moreau earned 200 total points
Comment Utility
You can use this:

Public Sub CopyTableFull( _
  dbsSource As DAO.Database, _
  strTable As String, _
  strDestination As String, _
  fStructureOnly As Integer)
  ' Comments  : copies a table from one database to another, including
  '             all properties and indexes and optionally, the table's data
  ' Parameters: dbsSource - a pointer to the databse
  '             strTable - name of the table to copy
  '             strDestination - path and name of the database to copy to
  '             fStructureOnly - True to copy only the structure,
  '             False to copy the structure and the data
  ' Note      : DAO does not allow the creation of certain Access-defined
  '             field properites. These include ColumnWidth, ColumnOrder
  '             and ColumnHidden. Because of this, CopyTableFull() may not
  '             be able to recreate all field property settings in the
  '             destination table. After using this function, be sure
  '             to check the resulting table for accuracy and any needed
  '             manual changes.
  ' Returns   : Nothing
  ' Source    : Total Visual SourceBook 2000
  '
  Dim dbsDest As DAO.Database
  Dim tdfSource As DAO.TableDef
  Dim tdfDest As DAO.TableDef
  Dim fldSource As DAO.Field
  Dim fldDest As DAO.Field
  Dim idxSource As DAO.Index
  Dim idxDest As DAO.Index
  Dim intCounter As Integer
  Dim intCounter2 As Integer
  Dim intCounter3 As Integer
  Dim intSaveErr As Integer
  Dim strName As String
  Dim prpNew As DAO.Property
  Dim strSQL As String

  On Error GoTo PROC_ERR

  Set dbsDest = DBEngine.Workspaces(0).OpenDatabase(strDestination)

  ' Clone the Tabledef
  Set tdfSource = dbsSource.TableDefs(strTable)
  Set tdfDest = dbsDest.CreateTableDef(tdfSource.Name)

  ' Set pre-append Tabledef properties
  tdfDest.Properties("Attributes") = tdfSource.Properties("Attributes")
  tdfDest.Properties("SourceTableName") = tdfSource.Properties("SourceTableName")

  ' Copy the fields
  For intCounter = 0 To tdfSource.Fields.Count - 1
    Set fldSource = tdfSource.Fields(intCounter)
    Set fldDest = tdfDest.CreateField(fldSource.Name, fldSource.Properties("Type"))

    ' copy the field's properties
    For intCounter2 = 0 To fldSource.Properties.Count - 1
      strName = fldSource.Properties(intCounter2).Name
     
      On Error Resume Next
      fldDest.Properties(strName) = fldSource.Properties(strName)
      intSaveErr = Err
      On Error GoTo PROC_ERR
   
      Select Case intSaveErr
   
        Case 0
          ' No error.
   
        Case 3219
          ' Invalid operation. This means that the property is not writable.
          ' We can ignore these
         
        Case 3270
          ' Property doesn't exist. We need to create it
          Set prpNew = fldDest.CreateProperty(strName)
          prpNew.Type = fldSource.Properties(strName).Type
          prpNew.Value = fldSource.Properties(strName).Value
         
          ' This may also fail for properties that aren't valid for writing
          On Error Resume Next
          fldDest.Properties.Append prpNew
          On Error GoTo PROC_ERR
         
        Case 3001, 3267, 3251
          ' Generic Jet error, just skip the property.
   
        Case Else
          ' Assert the error
          Error intSaveErr
       
      End Select

    Next intCounter2

    ' append the field
    tdfDest.Fields.Append fldDest

  Next intCounter


  ' Append the new table
  dbsDest.TableDefs.Append tdfDest

  ' Clone the Tabledef properties
  For intCounter = 0 To tdfSource.Properties.Count - 1
    strName = tdfSource.Properties(intCounter).Name

    ' Don't try to clone the Name and OrderBy properties.
    If strName <> "Name" And strName <> "OrderBy" Then
     
      ' Handle property problems
      On Error Resume Next
      tdfDest.Properties(strName).Value = tdfSource.Properties(strName).Value
      intSaveErr = Err
      On Error GoTo PROC_ERR
 
      Select Case intSaveErr
 
        Case 0
          ' No error.
 
        Case 3219
          ' Invalid operation. This means that the property is not writable.
          ' We can ignore these
       
        Case 3270
          ' Property doesn't exist. We need to create it
          Set prpNew = tdfDest.CreateProperty(strName)
          prpNew.Type = tdfSource.Properties(strName).Type
          prpNew.Value = tdfSource.Properties(strName).Value
          tdfDest.Properties.Append prpNew
 
        Case 3268
          ' Can't set property once appended. These are handled by the
          ' pre-append property settings earlier in the code.
           
        Case 3001, 3267, 3251
          ' Generic Jet error, just skip the property.
 
        Case Else
          ' Assert the error
          Error intSaveErr
       
      End Select
     
    End If
     
  Next intCounter

  ' Copy the indexes
  For intCounter = 0 To tdfSource.Indexes.Count - 1
    Set idxSource = tdfSource.Indexes(intCounter)
    ' Don't copy "foreign" indexes. These indexes are created
    ' and maintained by Access to support relationships with
    ' enforced referential integrity.
    If Not (idxSource.Foreign) Then
      Set idxDest = tdfSource.CreateIndex(idxSource.Name)
 
      ' Set the pre-append index properties
      idxDest.Properties("Primary") = idxSource.Properties("Primary")
      idxDest.Properties("Unique") = idxSource.Properties("Unique")
      idxDest.Properties("Clustered") = idxSource.Properties("Clustered")
      idxDest.Properties("Required") = idxSource.Properties("Required")
      idxDest.Properties("IgnoreNulls") = idxSource.Properties("IgnoreNulls")
 
      ' Copy the index fields
      For intCounter2 = 0 To idxSource.Fields.Count - 1
        Set fldSource = idxSource.Fields(intCounter2)
        Set fldDest = idxDest.CreateField(fldSource.Name)
 
        ' Clone the index field properties
        For intCounter3 = 0 To fldSource.Properties.Count - 1
          strName = fldSource.Properties(intCounter3).Name
         
          On Error Resume Next
          fldDest.Properties(strName).Value = fldSource.Properties(strName).Value
          intSaveErr = Err
          On Error GoTo PROC_ERR
       
          Select Case intSaveErr
       
            Case 0
              ' No error.
       
            Case 3219
              ' Invalid operation. This means that the property is not writable.
              ' We can ignore these
             
            Case 3270
              ' Property doesn't exist. We need to create it
              Set prpNew = tdfDest.CreateProperty(strName)
              prpNew.Type = tdfSource.Properties(strName).Type
              prpNew.Value = tdfSource.Properties(strName).Value
              tdfDest.Properties.Append prpNew
             
            Case 3001, 3267, 3251
             ' Generic Jet error, just skip the property.
       
            Case Else
              ' Assert the error
              Error intSaveErr
           
          End Select
 
        Next intCounter3
 
        ' Append the index field
        idxDest.Fields.Append fldDest
 
      Next intCounter2
 
      ' Append the new index
      tdfDest.Indexes.Append idxDest
 
      ' Set the index properties
      For intCounter2 = 0 To idxSource.Properties.Count - 1
     
        strName = idxSource.Properties(intCounter2).Name
       
        On Error Resume Next
        idxDest.Properties(strName) = idxSource.Properties(strName)
        intSaveErr = Err
        On Error GoTo PROC_ERR
     
        Select Case intSaveErr
     
          Case 0
            ' No error.
     
          Case 3219
            ' Invalid operation. This means that the property is not writable.
            ' We can ignore these
 
          Case 3268
            ' Can't set property once appended. These are handled by the
            ' pre-append property settings earlier in the code.
 
          Case 3270
            ' Property doesn't exist. We need to create it
            Set prpNew = idxDest.CreateProperty(strName)
            prpNew.Type = idxSource.Properties(strName).Type
            prpNew.Value = idxSource.Properties(strName).Value
            idxDest.Properties.Append prpNew
           
          Case 3001, 3267, 3251
            ' Generic Jet error, just skip the property.
     
          Case Else
            ' Assert the error
            Error intSaveErr
         
        End Select
 
      Next intCounter2
 
    End If

  Next intCounter

  ' Copy the data if requested
  If Not fStructureOnly Then
    strSQL = "INSERT INTO [" & strTable & "] IN '" & strDestination & "' "
    strSQL = strSQL & "SELECT [" & strTable & "].* "
    strSQL = strSQL & "FROM [" & strTable & "];"
    dbsSource.Execute strSQL
  End If

PROC_EXIT:
  Exit Sub

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "CopyTableFull"
  Resume PROC_EXIT

End Sub

' Example code for CopyTableFull

Private Sub cmdTest_Click()
  Dim dbsNwind As DAO.Database
 
  Set dbsNwind = DBEngine(0).OpenDatabase("c:\northwind.mdb")
 
  ' Example code for CopyTableFull
  CopyTableFull dbsNwind, "FMS_TEST", "c:\Northwind2.mdb", False
 
End Sub
0
 

Author Comment

by:mltolun
Comment Utility
THANKS!! it's perfect
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now