Office: 1:n Beziehung per VBA erstellen

chrisinform · 17. Juli 2004

Hallo Leute,

ich möchte gerne per VBA zwischen den Tabellen Tab1 und Tab2 eine 1:n Beziehung (jeweils Feld1) erstellen ohne referetielle Integrität.

(Hintergrund sind die sich ergebenen Anzeigemöglichkeiten in der Tabelle)

Wie geht das?

Dank und Gruß, Christian

:)

TommyK · 18. Juli 2004

Hallo,

mit der folgenden Prozedur. Es etwas länger da universell.
Kannste ja bei Bedarf kürzen.
Code:

Public Sub AddRelation(strRName As String, strTbl As String, strFremdtbl As String, _
strMasterfld As String, strFremdfld As String, intAtt As Integer)
'*******************************************
'Name: AddRelations (Sub)
'Purpose:
'Author: Thomas Keßler
'Date: Dezember 28, 2002, 10:58:03
'Inputs: strRName = eindeutige Bezeichung der Relation
' strtbl = Name der Tabelle, strFremdtbl Name der Fremdtabelle
' strMasterfld = Feldbezeichnung Tabelle, strFremdfld =Feldbezeichnung Fremdtabelle
' intAtt=0 mit referentielle Integrität (beide gleich)
' intAtt=1 1:1 Beziehung
' intAtt=2 ohne refenzielle Integrität
' intAtt=3 mit refenzielle Integrität und Aktualisierungsweitergabe
' intAtt=4 mit refenzielle Integrität und Löschweitergabe
' intAtt=5 mit refenzielle Integrität Aktualisierungsweitergabe und Löschweitergabe
' intAtt=6 mit referentielle Integrität (alle 1. Tabelle)
' intAtt=7 mit ohne referentielle Integrität (alle 1. Tabelle)
' intAtt=8 mit referentielle Integrität (alle 1. Tabelle) mit Aktualisierungsweitergabe
' intAtt=9 mit referentielle Integrität (alle 1. Tabelle) mit Löschweitergabe
' intAtt=10 mit referentielle Integrität (alle 1. Tabelle) mit Aktualisierungsweitergabe und Löschweitergabe
' intAtt=11 mit referentielle Integrität (alle 2. Tabelle)
' intAtt=12 ohne referentielle Integrität (alle 2. Tabelle)
' intAtt=13 mit referentielle Integrität (alle 2. Tabelle) mit Aktualisierungsweitergabe
' intAtt=14 mit referentielle Integrität (alle 2. Tabelle) mit Löschweitergabe
' intAtt=15 mit referentielle Integrität (alle 2. Tabelle) mit Aktualisierungsweitergabe und Löschweitergabe
' strPasswort= DB-Kennwort
'Output:
'*******************************************
On Error GoTo Fehler

Const WITH_REF_ALL = 0
Const ONE_TO_ONE = 1
Const WITHOUT_REF_ALL = 2
Const WITH_REF_ALL_REFRESH = 256
Const WITH_REF_ALL_DELETE = 4096
Const WITH_REF_ALL_REFRESH_DELETE = 4352
Const WITH_REF_L_INNERJOIN = 16777216
Const WITHOUT_REF_L_INNERJOIN = 16777218
Const WITH_REF_L_INNERJOIN_REFRESH = 16777472
Const WITH_REF_L_INNERJOIN_DELETE = 16781312
Const WITH_REF_L_INNERJOIN_REFRESH_DELETE = 16781568
Const WITH_REF_R_INNERJOIN = 33554432
Const WITHOUT_REF_R_INNERJOIN = 33554434
Const WITH_REF_R_INNERJOIN_REFRESH = 33554688
Const WITH_REF_R_INNERJOIN_DELETE = 33558528
Const WITH_REF_R_INNERJOIN_REFRESH_DELETE = 33558784

Dim dbs As DAO.DATABASE, REL As DAO.Relation, Fld As DAO.field

Set dbs = CurrentDb

'Löschen einer bereits bestehenden Beziehung
For Each REL In dbs.Relations
If REL.Table = strTbl And REL.ForeignTable = strFremdtbl Then dbs.Relations.Delete REL.Name
Next REL

Set REL = dbs.CreateRelation(strRName)
REL.Table = strTbl
REL.ForeignTable = strFremdtbl

Select Case intAtt
Case 0
REL.Attributes = WITH_REF_ALL
Case 1
REL.Attributes = ONE_TO_ONE
Case 2
REL.Attributes = WITHOUT_REF_ALL
Case 3
REL.Attributes = WITH_REF_ALL_REFRESH
Case 4
REL.Attributes = WITH_REF_ALL_DELETE
Case 5
REL.Attributes = WITH_REF_ALL_REFRESH_DELETE
Case 6
REL.Attributes = WITH_REF_L_INNERJOIN
Case 7
REL.Attributes = WITHOUT_REF_L_INNERJOIN
Case 8
REL.Attributes = WITH_REF_L_INNERJOIN_REFRESH
Case 9
REL.Attributes = WITH_REF_L_INNERJOIN_DELETE
Case 10
REL.Attributes = WITH_REF_L_INNERJOIN_REFRESH_DELETE
Case 11
REL.Attributes = WITH_REF_R_INNERJOIN
Case 12
REL.Attributes = WITHOUT_REF_R_INNERJOIN
Case 13
REL.Attributes = WITH_REF_R_INNERJOIN_REFRESH
Case 14
REL.Attributes = WITH_REF_R_INNERJOIN_DELETE
Case 15
REL.Attributes = WITH_REF_R_INNERJOIN_REFRESH_DELETE
End Select

Set Fld = REL.CreateField(strMasterfld)
Fld.ForeignName = strFremdfld

REL.Fields.Append Fld
dbs.Relations.Append REL
dbs.Relations.Refresh

Set dbs = Nothing

GoTo Exit_Here

Exit_Here:
Exit Sub

Fehler:
If Err = 3022 Then
MsgBox "Sie können für angegebenen Tabellen keine 1:1 Beziehung erstellen. Vorgang wird abgebrochen.", vbCritical, "Fehler": Exit Sub
ElseIf Err = 3009 Or Err = 3045 Or Err = 3051 Or Err = 3008 Or Err = 3262 Then
MsgBox "Die angegebene Datei bzw. Tabelle wird bereits verwendet. Vorgang wird abgebrochen.", vbCritical, "Fehler": Exit Sub
ElseIf Err = 3368 Then
MsgBox "Verknüpfte Felder müssen vom gleichen Datentyp sein. Vorgang wird abgebrochen.", vbCritical, "Fehler": Exit Sub
Else
Dim strErrString As String
strErrString = "Error Information..." & vbcrlf
strErrString = strErrString & "Error#: " & Err.Number & vbcrlf
strErrString = strErrString & " Description: " & Err.Description & vbcrlf
MsgBox strErrString, vbCritical + vbOKOnly, "Error in Modul in Sub: AddRelation"
Resume Exit_Here
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Aufruf:
Code:

AddRelation "DeineRelaBezeichnung", "DeineMasterTabelle", "DeineFremdTabelle", "FeldinMasterTabelle", "FeldFremdTabelle", 2
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

chrisinform · 18. Juli 2004

na... das nenne ich mal eine Funktion! Funktioniert super und Fehler sind abgefangen

Eine Frage vielleicht. Wozu ist der Name der Relation. Man kann da angeben was man möchte (wird aber auch nirgends angezeigt)

- Christian

TommyK · 18. Juli 2004

Hallo,

der Name der Relation muss angegeben werden.
Access selber erstellt diesen aus beiden Tabellennamen.
Ansehen kannst Du sie in der Systemtabelle "MSysRelationships"
Im Menu "Extras" auf "Optionen" gehen und Systemobjekte anzeigen, Haken setzen.

Du könntest auch gleich in der Sub den Namen aus beiden Tabellennamen bilden.

chrisinform · 19. Juli 2004

danke!

Office: 1:n Beziehung per VBA erstellen

1:n Beziehung per VBA erstellen

1:n Beziehung per VBA erstellen

1:n Beziehung per VBA erstellen

1:n Beziehung per VBA erstellen - Similar Threads - Beziehung VBA erstellen

Datenmodell bei abgestufter Mitgliedschaft

Beziehungen zw. 2 Tabellen

Formular/ Unterformular/ m:n Beziehung

Vergehensweise beim Anlegen eines DB Projekts

Formeln aus Mastertabelle

Primärschlüssel/Fremdschlüssel aus 2.Tabelle automatisch einfügen

VBA Textbox und Namen definieren/ auf andere Mappe beziehen