Für 32Bit und 64Bit Office Versionen
Problemstellung:
Wie kann ich eine leere Tabellen-Kopie mittels DAO erstellen?
Verweis auf die Microsoft DAO 3.X Object Library erforderlich
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
Aufruf:
Call TableCopyDAO("tblNeu", "tbl_TestNeu")
würde, in der aktuellen DB, von der Tabelle "tblNeu" eine 1:1 Kopie mit dem Namen "tblTest_Neu" erstellen.
Es wurden alle Felder, Indizies und benutzerdefinierte Eigenschaften kopiert.
Ähnliche Artikel
Weiterlesen...