Public Sub CopyTable(ByVal sourceTableName As String, ByVal destinationTableName As String, Optional bCopyData As Boolean = False)
On Error GoTo Err_Handler

    'Credit for this code goes to: http://stackoverflow.com/questions/1594096/how-to-copy-a-linked-table-to-a-local-table-in-ms-access-programmatically

    'Doesn't copy indexes or primary keys on Queries (which is probably to be expected)
    
    Dim cn As ADODB.Connection
    Dim cat As ADOX.Catalog
    Dim sourceTable As ADOX.Table
    Dim destinationTable As ADOX.Table
    
    Set cn = CurrentProject.Connection
    Set cat = New ADOX.Catalog
    Set cat.ActiveConnection = cn
    
    Set destinationTable = New ADOX.Table
    destinationTable.Name = destinationTableName
    
    Set sourceTable = cat.Tables(sourceTableName)
    
    Dim col As ADOX.Column
    For Each col In sourceTable.Columns
       Dim newCol As ADOX.Column
       Set newCol = New ADOX.Column
    
       With newCol
          .Name = col.Name
          .Attributes = col.Attributes
          .DefinedSize = col.DefinedSize
          .NumericScale = col.NumericScale
          .Precision = col.Precision
          .Type = col.Type
       End With
    
       destinationTable.Columns.Append newCol
    Next col

    Dim key As ADOX.key
    Dim newKey As ADOX.key
    
    Dim KeyCol As ADOX.Column
    Dim newKeyCol As ADOX.Column
    For Each key In sourceTable.Keys
       Set newKey = New ADOX.key
       newKey.Name = key.Name
       For Each KeyCol In key.Columns
          Set newKeyCol = destinationTable.Columns(KeyCol.Name)
          newKey.Columns.Append (newKeyCol)
       Next KeyCol
    
       destinationTable.Keys.Append newKey
    Next key

    cat.Tables.Append destinationTable
    
    Call copyTableIndexes(cn, cn, sourceTableName, destinationTableName)

    If bCopyData = True Then
        'Finally, copy data from source to destination table
        Dim sql As String
        sql = "INSERT INTO " & destinationTableName & " SELECT * FROM " & sourceTableName
        CurrentDb.Execute sql
    End If

Err_Handler:
   Set cat = Nothing
   Set key = Nothing
   Set col = Nothing
   Set sourceTable = Nothing
   Set destinationTable = Nothing
   Set cn = Nothing

   If Err.Number <> 0 Then
      MsgBox Err.Number & ": " & Err.Description, vbCritical, Err.Source
   End If
End Sub

Private Sub copyTableIndexes(ByRef srcConn As ADODB.Connection, ByRef dstConn As ADODB.Connection, srcTable As String, dstTable As String)
    
    Dim catSrc As New ADOX.Catalog, catDst As New ADOX.Catalog
    catSrc.ActiveConnection = srcConn
    catDst.ActiveConnection = dstConn
    
    Dim tblSrc As ADOX.Table, tblDst As ADOX.Table
    Dim idxSrc As ADOX.Index, idxDst As ADOX.Index
    Dim i As Integer
    
    Set tblSrc = catSrc.Tables(srcTable)
    Set tblDst = catDst.Tables(dstTable)
        
    For Each idxSrc In tblSrc.Indexes
        
        Set idxDst = New ADOX.Index
        
        idxDst.Name = idxSrc.Name
        idxDst.Clustered = idxSrc.Clustered
        'idxDst.IndexNulls = idxSrc.IndexNulls 'can't copy this one ?!
        idxDst.PrimaryKey = idxSrc.PrimaryKey
        idxDst.Unique = idxSrc.Unique
        For i = 0 To idxSrc.Columns.Count - 1
            idxDst.Columns.Append idxSrc.Columns(i).Name
            idxDst.Columns(idxSrc.Columns(i).Name).SortOrder = idxSrc.Columns(i).SortOrder
        Next
        On Error Resume Next   'just pass the indexes that I can't copy
        tblDst.Indexes.Append idxDst
        Set idxDst = Nothing
    Next
    
End Sub


Public Function RecordsInTable(ByVal sTableName As String, _
                            Optional ByRef dbIn As DAO.Database, _
                            Optional ByRef sDBPath As String) As Long
    If sTableName = "" Then Exit Function
    Dim db As DAO.Database, bClose As Boolean
    If Not dbIn Is Nothing Then
       Set db = dbIn
    ElseIf sDBPath <> "" Then
        
        If Dir(sDBPath) = "" Then
            If Left(sDBPath, 2) <> "\\" And Mid(sDBPath, 2, 1) <> ":" Then
                'Assume database is in currentproject directory
                sDBPath = CurrentProject.Path & "\" & sDBPath
            End If
        End If
        
        If Dir(sDBPath) = "" Then
            MsgBox "The database you specified cannot be found."
            Exit Function
        End If
        
        Set db = OpenDatabase(sDBPath) 'assumes blank password
        bClose = True

    Else
        Set db = CurrentDb
    End If
    
    If Not db Is Nothing Then
        If TableExists(sTableName, db) <> "" Then
            Dim r As DAO.Recordset
            Set r = db.OpenRecordset("SELECT Count(*) As RecordCount FROM " & sTableName, dbOpenDynaset, dbSeeChanges)
            If Not (r.EOF And r.BOF) Then
                RecordsInTable = r("RecordCount").Value
            Else
                RecordsInTable = 0
            End If
            r.Close
            Set r = Nothing
        Else
            RecordsInTable = -1
        End If
        If bClose = True Then db.Close
        Set db = Nothing
    Else
        RecordsInTable = -1
    End If
    
End Function


Public Function TableExists(ByVal sTableName As String, _
                            Optional ByRef dbIn As DAO.Database, _
                            Optional ByRef sDBPath As String) As String
                                
    'This Function returns "Local", "Linked", or ""
    
    If sTableName = "" Then Exit Function
    Dim db As DAO.Database
    If Not dbIn Is Nothing Then
       Set db = dbIn
       TableExists = TableExists2(sTableName, db)
       Set db = Nothing
    ElseIf sDBPath <> "" Then
        
        If Dir(sDBPath) = "" Then
            If Left(sDBPath, 2) <> "\\" And Mid(sDBPath, 2, 1) <> ":" Then
                'Assume database is in currentproject directory
                sDBPath = CurrentProject.Path & "\" & sDBPath
            End If
        End If
        
        If Dir(sDBPath) = "" Then
            MsgBox "The database you specified cannot be found."
            Exit Function
        End If
        
        'OpenDatabase Method: http://msdn.microsoft.com/en-us/library/bb243164(v=office.12).aspx
        Set db = OpenDatabase(sDBPath) 'assumes blank password
        TableExists = TableExists2(sTableName, db)
        db.Close
        Set db = Nothing

    Else
        Set db = CurrentDb
        TableExists = TableExists2(sTableName, db)
        Set db = Nothing
    End If
                            
End Function

Private Function TableExists2(ByVal sTableName As String, _
                                ByRef dbIn As DAO.Database) As String
     Dim i As Integer
     For i = 0 To dbIn.TableDefs.Count - 1
        If dbIn.TableDefs(i).Name = sTableName Then
            If dbIn.TableDefs(i).Connect <> "" Then
                TableExists2 = "Linked"
            Else
                TableExists2 = "Local"
            End If
        End If
    Next i
End Function