copying an access table

Function CloneTDef(RefTDef As TableDef) As TableDef
    On Local Error GoTo Fehler
    '____________________________________________

    Dim NewTDef As TableDef
   
    Dim RefField As Field
    Dim NewField As Field
   
    Dim RefInd As Index
    Dim NewInd As Index
   
    Dim RefProp As Property
   
    '____________________________________________
    Set NewTDef = New TableDef
   
    '____________________________________________PROPERTIES
    For Each RefProp In RefTDef.Properties
        NewTDef.Properties(RefProp.Name).Type = RefProp.Type
        NewTDef.Properties(RefProp.Name).Value = RefProp.Value
        DoEvents
    Next
    NewTDef.Properties.Refresh
   
    '____________________________________________FIELDS
    For Each RefField In RefTDef.Fields
        Set NewField = NewTDef.CreateField
        For Each RefProp In RefField.Properties
            NewField.Properties(RefProp.Name).Type = RefProp.Type
            NewField.Properties(RefProp.Name).Value = RefProp.Value
            DoEvents
        Next
        NewTDef.Fields.Append NewField
    Next
    NewTDef.Fields.Refresh
   
    '____________________________________________INDEXES
   
    For Each RefInd In RefTDef.Indexes
        Set NewInd = NewTDef.CreateIndex

        For Each RefProp In RefInd.Properties
            NewInd.Properties(RefProp.Name).Type = RefProp.Type
            NewInd.Properties(RefProp.Name).Value = RefProp.Value
            DoEvents
        Next
       
        For Each RefField In RefInd.Fields
            Set NewField = NewInd.CreateField
            For Each RefProp In RefField.Properties
                NewField.Properties(RefProp.Name).Type = RefProp.Type
                NewField.Properties(RefProp.Name).Value = RefProp.Value
                DoEvents
            Next
            NewInd.Fields.Append NewField
        Next
        NewTDef.Indexes.Append NewInd
    Next
   
    NewTDef.Indexes.Refresh
   
    '____________________________________________
           
    Set CloneTDef = NewTDef
   
   
    Exit Function
Fehler:
    Select Case Err
        Case 3001, 3219, 3251, 3267, 3270, 3420
            Resume Next
        Case Else
            MsgBox Error
            Exit Function
    End Select
End Function


Sub ReplaceTable(NewTDef As TableDef, db As Database)
    On Local Error GoTo Fehler
    '____________________________________________
    If Not GetTableDef(db, NewTDef.Name) Is Nothing Then
        db.TableDefs.Delete (NewTDef.Name)
        db.TableDefs.Refresh
    End If
    db.TableDefs.Append NewTDef
    db.TableDefs.Refresh
    '____________________________________________
    Exit Sub
Fehler:
    Select Case Err
        Case Else
            MsgBox Error
            Exit Sub
    End Select
End Sub

Call ReplaceTable(CloneTDef(TDef), db)

sorry, a function is missing:

Public Function GetTableDef(db As Database, tabelle As String) As TableDef
    On Local Error GoTo Fehler
    '------------------------------------------------------------------------------------------
    Dim TDef As TableDef
    Set GetTableDef = Nothing
   
    For Each TDef In db.TableDefs
        If TDef.Name = tabelle Then
            Set GetTableDef = TDef
            Exit For
        End If
    Next
   
    '------------------------------------------------------------------------------------------
    Exit Function
Fehler:
    Select Case Err
        Case Else
            MsgBox Error
    End Select
End Function