Question : Copy access tables from one database to another

I have a MS Access 2000 database which i want to take certain tables from and store them in another database file.

I want the process to be automated (using VB6/VBA).

Both databases are password protected by a database password.

Please help, i'm having real problems.

Thanks

PS - Ideally I would like to be able to copy certain records across, perhaps using a select statement, that would be ideal.

Answer : Copy access tables from one database to another

Hey mt,

This is the code from the other question I found. All I did to it was to add a password string to the parameters and modify the OpenDatabase method within the routine to use this. It's a fair amount of code to do what I thought would initially only take one line. :) Anyway, it works so give it try.


Hope this helps.
Sean


Public Sub CopyTableFull( _
 dbsSource As DAO.Database, _
 strTable As String, _
 strDestination As String, _
 strPWD 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
 '             strPWD - password used for db
 '             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, False, False, ";pwd=" & strPWD)

 ' 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()
 Dim dbsMain As DAO.Database
 
 'Use this line if the db used for the export is independant of the two password protected ones
 'Set dbsMain = DBEngine(0).OpenDatabase("c:\db1.mdb",False,False,";pwd=xxx")
 
 'If you are in the CurrentDb and wish to export to another db that is passwod protected
 Set dbsMain = CurrentDb
 
 ' Example code for CopyTableFull
 'This is the format -> CopyTableFull(dbsSource, strTable, strDestination, strPWD, fStructureOnly)
 
 CopyTableFull dbsMain, "YourTable", "C:\db2.mdb", "xxx", False
 
End Sub