TKSoft-Online

Public Sub TableCopyDAO(strTabname As String)
'*******************************************
'Name:      TableCopyDAO (Sub)
'Purpose:   erstellt eine leere 1:1 Kopie einer Tabelle
'Author:    Thomas Keßler, Anne Berg
'Date:      Mai 06, 2005, 07:08:57
'Inputs:    strTabName=Tabellenname
'Output:
'*******************************************

    On Error Resume Next

    Dim dbs As DAO.Database
    Dim tdfq As DAO.TableDef, tdfz As DAO.TableDef
    Dim fldq As DAO.Field, fldz As DAO.Field
    Dim idxq As DAO.Index, idxz As DAO.Index, fldIndexq As DAO.Field, fldIndexz As DAO.Field
    Dim prpq As DAO.Property, prpz As DAO.Property

    Set dbs = CurrentDb
    Set tdfq = dbs.TableDefs(strTabname)
    Set tdfz = dbs.CreateTableDef(strTabname & "_Temp000")

    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
    'Codeteil zum hinzufügen der Felder in der neuen 
    'Tabelle und zuweisen der DAO-Eigenschaften 
    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
    For Each fldq In tdfq.Fields
        Set fldz = tdfz.CreateField(fldq.Name, fldq.Type, fldq.Size)
        fldz.Attributes = fldq.Attributes
        If fldq.Required Then fldz.Required = True
        If fldq.AllowZeroLength Then fldz.AllowZeroLength = True
        fldz.DefaultValue = fldq.DefaultValue
        fldz.ValidationRule = fldq.ValidationRule
        fldz.ValidationText = fldq.ValidationText
        tdfz.Fields.Append fldz
        tdfz.Fields.Refresh
    Next fldq

    dbs.TableDefs.Append tdfz
    dbs.TableDefs.Refresh

    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
    'Codeteil zum hinzufügen der Indexes und 
    'der Indexfelder und Index-Eigenschaften 
    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
    For Each idxq In tdfq.Indexes
        Set idxz = tdfz.CreateIndex(idxq.Name)
        If idxq.Primary Then idxz.Primary = True
        If idxq.Unique Then idxz.Unique = True
        If idxq.Required Then idxz.Required = True
        If idxq.IgnoreNulls Then idxz.IgnoreNulls = True
        For Each fldIndexq In idxq.Fields
            Set fldIndexz = idxz.CreateField(fldIndexq.Name)
            fldIndexz.Attributes = fldIndexq.Attributes
            idxz.Fields.Append fldIndexz
        Next fldIndexq
        tdfz.Indexes.Append idxz
        tdfz.Indexes.Refresh
    Next idxq
    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 

    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
    'Codeteil zum hinzufügen der Properties der Felder 
    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
    For Each fldq In tdfq.Fields
        Set fldz = tdfz.Fields(fldq.Name)
        For Each prpq In fldq.Properties
            Set prpz = fldz.CreateProperty(prpq.Name, prpq.Type, prpq.Value)
            fldz.Properties.Append prpz
            fldz.Properties.Refresh
        Next prpq
    Next fldq
    '­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
    Set dbs = Nothing

End Sub