Tabellenstruktur kopieren (DAO) Hier zeigen wir, wie man die Struktur (Felddefinitionen) einer Tabelle von Datenbank A nach Datenbank B kopiert.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  18.840
www.tools4vb.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	kein Beispielprojekt

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 23 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.7 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Heute möchten wir Ihnen zeigen, wie sich die Tabellenstruktur (Felddefinitionen) einer bestimmten Tabelle von Datenbank A nach Datenbank B kopieren lässt. Als Datenbankzugriff verwenden wir DAO 3.51 bzw. DAO 3.6.

' Diese Funktion erstellt ein neues TableDef-Objekt 
' mit allen Feldern der übergebenen Tabellen
Public Function dbCopyTableDef(oTableDef As DAO.TableDef) _
  As DAO.TableDef
 
  Dim oField As DAO.Field
  Dim oIndex As DAO.Index
  Dim i As Integer
 
  Set dbCopyTableDef = New DAO.TableDef
  With dbCopyTableDef
    .Name = oTableDef.Name
 
    ' alle Felder durchlaufen und erstellen
    For i = 0 To oTableDef.Fields.Count - 1
      Set oField = New DAO.Field
      With oTableDef.Fields(i)
        On Error Resume Next
        oField.Name = .Name
        oField.Type = .Type
        oField.Size = .Size
        oField.Attributes = .Attributes
        oField.DefaultValue = .DefaultValue
        oField.OrdinalPosition = .OrdinalPosition
        oField.AllowZeroLength = .AllowZeroLength
      End With
      .Fields.Append oField
    Next i
  End With
End Function

Der Aufruf erfolgt dann in etwa so:

Dim oDBSource As DAO.Database
Dim oDBDest As DAO.Database
Dim oTableDef As TableDef
 
' Quell-Datenbank öffnen
Set oDBSource = DBEngine.OpenDatabase("Datenbank1.mdb")
 
' Ziel-Datenbank öffnen
Set oDBDest = DBEngine.OpenDatabase("Datenbank2.mdb")
 
' Jetzt Tabellenstruktur kopieren
Set oTableDef = dbCopyTableDef(oDBSource.TableDefs("Tabellenname"))
oDBDest.TableDefs.Append oTableDef
 
' Datenbanken schließen  
oDBDest.Close
oDBSource.Close

Erweiterung des Tipps:
Wir möchten alle Tabellen (Tabellenstrukturen) aus Datenbank A in die Datenbank B kopieren, aber nur dann, wenn die Tabelle in Datenbank B noch nicht vorhanden ist. Hierzu müssen wir alle Tabellen in der Datenbank A der Reihe nach durchlaufen und prüfen, ob es in Datenbank B bereits eine Tabelle mit der jeweiligen Bezeichnung gibt. Falls nicht, wird die Tabelle mit Hilfe der dbCopyTableDef-Funktion erstellt. Systemtabellen, die direkt von Access erstellt wurden, dürfen allerdings nicht berücksichtigt werden.

Dim oDBSource As DAO.Database
Dim oDBDest As DAO.Database
Dim oTableDef As TableDef
Dim oNewTableDef As TableDef
 
' Quell-Datenbank öffnen
Set oDBSource = DBEngine.OpenDatabase("Datenbank1.mdb")
 
' Ziel-Datenbank öffnen
Set oDBDest = DBEngine.OpenDatabase("Datenbank2.mdb")
 
' alle Tabelle der Quelldatenbank durchlaufen
' und prüfen, ob diese in der Zieldatenbank existieren
For Each oTableDef In oDBSource.TableDefs
  ' nur wenn keine Systemtabelle
  If LCase$(Left$(oTableDef.Name, 4)) <> "msys" Then
    If Not dbTableExists(oDBDest, oTableDef.Name) Then
      ' Jetzt Tabellenstruktur kopieren
      Set oNewTableDef = dbCopyTableDef(oTableDef)
      oDBDest.TableDefs.Append oNewTableDef
    End If
  End If
Next
oDBDest.Close
oDBSource.Close

' Prüfen, ob Tabelle in der Datenbank vorhanden
Private Function dbTableExists(oDB As Database, _
  ByVal sTableName As String) As Boolean
 
  Dim oTable As TableDef
 
  For Each oTable In oDB.TableDefs
    If oTable.Name = sTableName Then
      dbTableExists = True
      Exit For
    End If
  Next
End Function