[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 199
  • Last Modified:

Copy table from one database to another

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
mltolun
Asked:
mltolun
1 Solution
 
Éric MoreauSenior .Net ConsultantCommented:
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
 
mltolunAuthor Commented:
THANKS!! it's perfect
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now