title image


Smiley Re: Tabellen über VBA importieren mit Beziehungen
Da musst du die Relations-Auflistung auswerten:Public Function CopyAllRelations(Optional From_DBName As String = "", Optional To_DBName As String = "")Dim FromDB As Database, ToDB As Database, FromRel As Relation, ToRel As Relation, ErN As Long, MerkRel As StringDim ToTbl As TableDef, FromFld As Field, ToFld As Field, ToDBName As String, FromDBName As String ToDBName = To_DBName: FromDBName = From_DBName If From_DBName = "" Then FromDBName = CurrentDb.Name If To_DBName = "" Then ToDBName = CurrentDb.Name If FromDBName = ToDBName Then MsgBox "Ziel und Quelle sind identisch!", vbExclamation Exit Function End If Set FromDB = DBEngine.OpenDatabase(FromDBName) Set ToDB = DBEngine.OpenDatabase(ToDBName) For Each FromRel In FromDB.Relations MerkRel = "" For Each ToRel In ToDB.Relations MerkRel = "" If ToRel.Table = FromRel.Table And ToRel.ForeignTable = FromRel.ForeignTable Then MerkRel = ToRel.Name For Each ToFld In ToRel.Fields On Error Resume Next Set FromFld = FromRel.Fields(ToFld.Name) ErN = Err.Number On Error GoTo 0 If ErN 0 Then MerkRel = "" Exit For End If Next ToFld End If Next ToRel' Beziehung löschen, wenn sie schon besteht... If MerkRel "" Then ToDB.Relations.Delete MerkRel On Error Resume Next Err.Clear Set ToTbl = ToDB.TableDefs(FromRel.Table) ErN = Err.Number On Error GoTo 0 If ErN = 0 Then On Error Resume Next Err.Clear Set ToTbl = ToDB.TableDefs(FromRel.ForeignTable) ErN = Err.Number On Error GoTo 0 If ErN = 0 Then With FromRel Set ToRel = ToDB.CreateRelation(.Name, .Table, .ForeignTable, .Attributes)' Alle Felder übernehmen For Each FromFld In FromRel.Fields Set ToFld = ToRel.CreateField(FromFld.Name) ToFld.ForeignName = FromFld.ForeignName ToRel.Fields.Append ToFld Next FromFld ToDB.Relations.Append ToRel End With End If End If Next FromRelEnd FunctionReinhard


Gruß aus dem Norden
Reinhard


Bitte immer die Access-Version angeben!
DB-Wiki


Wie man Fragen richtig stellt

YaccessAccess-FAQUnd ansonsten: Wikipedia




geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: