|
-
Jan 30th, 2025, 02:40 PM
#4
Re: DAO CreateRelation - I Really need help with this please.
Ok, here are the "relationship" procedures I use. Maybe they'll help you.
However, as a note, that dbTheDatabase is expected to be opened exclusive before calling any of these procedures. In my project, that database object variable is just global to the entire project. I just declared it in the following module so I could make sure that code would at least compile in a BAS module. But, it's up to you to actually get the MDB file open.
Code:
Option Explicit
Public dbTheDatabase As DAO.Database
Public Sub DbAddRelationship(sPrimaryTableName As String, sForeignTableName As String, _
sPrimaryFieldNames() As String, sForeignFieldNames() As String, _
Optional bOneToMany As Boolean = True, _
Optional bEnforceIntegrity As Boolean = True, _
Optional bCascadeUpdates As Boolean = True, _
Optional bCascadeDeletes As Boolean = True)
'
' Sadly, these relationships DON'T show up on the MS_Access RELATIONSHIPS window until the table is manually added to the window.
'
Dim lAttributes As Long
Dim rel As DAO.Relation
Dim fdf As DAO.Field
Dim i As Long
'
' The following are relationship attributes.
If (Not bOneToMany) Then lAttributes = lAttributes Or dbRelationUnique ' One-to-one relationship.
If (Not bEnforceIntegrity) Then lAttributes = lAttributes Or dbRelationDontEnforce
If bCascadeUpdates Then lAttributes = lAttributes Or dbRelationUpdateCascade
If bCascadeDeletes Then lAttributes = lAttributes Or dbRelationDeleteCascade
'
Set rel = dbTheDatabase.CreateRelation(sPrimaryTableName & sForeignTableName)
rel.Table = sPrimaryTableName
rel.ForeignTable = sForeignTableName
rel.Attributes = lAttributes
'
For i = LBound(sPrimaryFieldNames) To UBound(sPrimaryFieldNames)
Set fdf = rel.CreateField(sPrimaryFieldNames(i))
fdf.ForeignName = sForeignFieldNames(i)
rel.Fields.Append fdf
Next
'
dbTheDatabase.Relations.Append rel
dbTheDatabase.Relations.Refresh
End Sub
Public Function DbRelationshipFieldsCount(sPrimaryTableName As String, sForeignTableName As String) As Long
' Returns zero if relationship not found.
'
Dim i As Long
For i = 0 To dbTheDatabase.Relations.Count - 1
If dbTheDatabase.Relations(i).Table = sPrimaryTableName And _
dbTheDatabase.Relations(i).ForeignTable = sForeignTableName Then
DbRelationshipFieldsCount = dbTheDatabase.Relations(i).Fields.Count
Exit Function
End If
Next
' It drops out if the relationship was not found.
End Function
Public Sub DbDeleteRelationship(sPrimaryTableName As String, sForeignTableName As String)
Dim i As Long
Dim sRelationName As String
'
For i = 0 To dbTheDatabase.Relations.Count - 1
If dbTheDatabase.Relations(i).Table = sPrimaryTableName And _
dbTheDatabase.Relations(i).ForeignTable = sForeignTableName Then
sRelationName = dbTheDatabase.Relations(i).Name
dbTheDatabase.Relations.Delete sRelationName
dbTheDatabase.Relations.Refresh
Exit Sub
End If
Next
' It drops out without notice if the relationship was not found.
End Sub
Public Sub DeleteAndAddRelationship(sPrimaryTableName As String, sForeignTableName As String, _
sPrimaryFieldNames() As String, sForeignFieldNames() As String)
'
If DbRelationShipExists(sPrimaryTableName, sForeignTableName) Then DbDeleteRelationship sPrimaryTableName, sForeignTableName
DbAddRelationship sPrimaryTableName, sForeignTableName, sPrimaryFieldNames(), sForeignFieldNames()
End Sub
Public Function DbRelationShipExists(sPrimaryTableName As String, sForeignTableName As String) As Boolean
Dim i As Long
'
For i = 0 To dbTheDatabase.Relations.Count - 1
If dbTheDatabase.Relations(i).Table = sPrimaryTableName And _
dbTheDatabase.Relations(i).ForeignTable = sForeignTableName Then
'
DbRelationShipExists = True
Exit Function
End If
Next
' If we fell out, it returns False.
DbRelationShipExists = False
End Function
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|