Access JumpStart 2.0 | Blog

A Rapid Development Framework for Microsoft Access

You can find the previous parts of this message here:

Copying Access Tables / Data using VBA Real World Case – Part 1 | Access JumpStart

Copying Access Tables / Data using VBA Real World Case – Part 2 | Access JumpStart

In Part 3 I discovered that the copied tables using this method had no indexed fields and no primary keys, I suspect the autonumber field was not autonumber any more as well, but I didn’t check that.

So I needed to not just SELECT INTO a table, but actually create a duplicate copy of the table structure including the indexes and field types.

Initially I tried to just create a new TableDef in the target database by using:

TableDefs.Append SourceDB.TabledDefs(SourceTableName)

However, this just tried to put the same object into the source database using the same connection properties that were in the new database. This did not and could not work. I need to replicate the fields and indexes collections in a new table.

Because I knew exactly what I wanted I was able to craft a pretty specific prompt for CoPilot and had a basic function to do what I needed to replicate the fields. I had to tell it to add the indexes for the fields which gave me about what I needed, which I was able to tweak to get to be exactly what I needed.

So here is the main function, updated with the new code:

Public Sub DeleteAndReCopyTables()
    Dim TableCollection As VBA.Collection
    Dim TblToCopy As EG_TableToCopy
    Dim itm As Variant
    Dim dbTrg As DAO.Database
    Set TableCollection = GetTableCollection()
    
    For Each itm In TableCollection
        Set TblToCopy = itm
        ' ---------- Here is what changed:
        CopyTableStructureWithIndexes _
             TblToCopy.SourceDbPath, TblToCopy.TargetDbPath, _
             TblToCopy.SourceTable, TblToCopy.TargetTable
        Set dbTrg = DBEngine.OpenDatabase(TblToCopy.TargetDbPath)
        dbTrg.Execute "INSERT INTO " & TblToCopy.TargetTable & _
                      " SELECT * FROM " & TblToCopy.SourceTable & _
                      " IN '" & TblToCopy.SourceDbPath & "'"
        ' ---------- End changes
        dbTrg.Close
        Set dbTrg = Nothing
        Set TblToCopy = Nothing
        Set itm = Nothing
    Next itm
    Set TableCollection = Nothing
End Sub

And unveiling the new function:

Private Function CopyTableStructureWithIndexes( _
       sourcePath As String, targetPath As String, 
       sourceTableName As String, targetTableName As String)
    Dim sourceDB As DAO.Database
    Dim targetDB As DAO.Database
    Dim tdfSource As DAO.TableDef
    Dim tdfNew As DAO.TableDef
    Dim idxSource As DAO.Index
    Dim idxNew As DAO.Index
    Dim fld As DAO.Field
    Dim fldNew As DAO.Field
    Dim varIdx As Variant
    
    ' Open the source database
    Set sourceDB = DBEngine.OpenDatabase(sourcePath)
    
    ' Open the target database
    Set targetDB = DBEngine.OpenDatabase(targetPath)
    
    ' Check if the table exists in the target database and delete it if it does
    For Each varIdx In targetDB.TableDefs
        If varIdx.Name = targetTableName Then
            targetDB.TableDefs.Delete targetTableName
            Exit For
        End If
    Next varIdx
    
    ' Get the table definition from the source database
    Set tdfSource = sourceDB.TableDefs(sourceTableName)
    
    ' Create a new table definition in the target database
    Set tdfNew = targetDB.CreateTableDef(targetTableName)
    
    ' Copy the fields from the source table to the new table
    For Each fld In tdfSource.Fields
        Set fldNew = tdfNew.CreateField(fld.Name, fld.Type, fld.Size)
        tdfNew.Fields.Append fldNew
    Next fld
    Set fld = Nothing
    Set fldNew = Nothing
    
    ' Copy the indexes from the source table to the new table
    For Each idxSource In tdfSource.Indexes
        Set idxNew = tdfNew.CreateIndex(idxSource.Name)
        idxNew.Primary = idxSource.Primary
        idxNew.Unique = idxSource.Unique
        idxNew.IgnoreNulls = idxSource.IgnoreNulls
        
        ' Copy the fields in the index
        For Each fld In idxSource.Fields
            idxNew.Fields.Append idxNew.CreateField(fld.Name)
        Next fld
        
        tdfNew.Indexes.Append idxNew
    Next idxSource
    Set idxSource = Nothing
    Set idxNew = Nothing
    
    ' Append the new table definition to the target database
    targetDB.TableDefs.Append tdfNew
    
    ' Clean up
    sourceDB.Close
    targetDB.Close
    Set sourceDB = Nothing
    Set targetDB = Nothing
    Set tdfSource = Nothing
    Set tdfNew = Nothing
End Function

So you can see it deletes then creates the new TableDef as a blank one in the target database, then loops over the fields and indexes and uses those to create the same structure from the source TableDef.