matthewnsarah07
Registered User.
- Local time
- Today, 13:08
- Joined
- Feb 19, 2008
- Messages
- 192
Hi
I currently have database that provides staff briefings, due to use of a Citrix Server and some very slow local connections there is one table in particular [tblcontent] that is only needed on occasion and therefore I create a link to that table as required via VBA.
This table then needs a relationship with another temporary table, I have been using the below CreateAllRelations function and though I get no errors it also doesn't appear to actual create the required relationship
Can anyone advise if I've overlooked something in the code?
I currently have database that provides staff briefings, due to use of a Citrix Server and some very slow local connections there is one table in particular [tblcontent] that is only needed on occasion and therefore I create a link to that table as required via VBA.
This table then needs a relationship with another temporary table, I have been using the below CreateAllRelations function and though I get no errors it also doesn't appear to actual create the required relationship
Can anyone advise if I've overlooked something in the code?
Code:
Public Function CreateAllRelations()
Dim db As DAO.Database
Dim totalRelations As Integer
Set db = CurrentDb()
totalRelations = db.Relations.Count
If totalRelations > 0 Then
For i = totalRelations - 1 To 0 Step -1
db.Relations.Delete (db.Relations(i).Name)
Next i
Debug.Print Trim(Str(totalRelations)) + " Relationships deleted!"
End If
Debug.Print "Creating Relations..."
''==========================
''Example
'Employee Master to Employee CheckIn
Debug.Print CreateRelation("Employee", "Code", _
"CheckIn", "Code")
''Orders to Order Details
Debug.Print CreateRelation("Orders", "No", _
"OrderDetails", "No")
''==========================
totalRelations = db.Relations.Count
Set db = Nothing
Debug.Print Trim(Str(totalRelations)) + " Relationships created!"
Debug.Print "Completed!"
End Function
Private Function CreateRelation(primaryTableName As String, _
primaryFieldName As String, _
foreignTableName As String, _
foreignFieldName As String) As Boolean
On Error GoTo ErrHandler
Dim db As DAO.Database
Dim newRelation As DAO.Relation
Dim relatingField As DAO.Field
Dim relationUniqueName As String
relationUniqueName = primaryTableName + "_" + primaryFieldName + _
"__" + foreignTableName + "_" + foreignFieldName
Set db = CurrentDb()
'Arguments for CreateRelation(): any unique name,
'primary table, related table, attributes.
Set newRelation = db.CreateRelation(MainLink, _
temp_content_modify, tblContent)
'The field from the primary table.
Set relatingField = newRelation.CreateField(ArticleID)
'Matching field from the related table.
relatingField.ForeignName = ArticleID
'Add the field to the relation's Fields collection.
newRelation.Fields.Append relatingField
'Add the relation to the database.
db.Relations.Append newRelation
Set db = Nothing
CreateRelation = True
Exit Function
ErrHandler:
Debug.Print Err.description + " (" + relationUniqueName + ")"
CreateRelation = False
End Function