Exporting relationships with VBA (also posted in exporting newsgroup)

  • Thread starter Thread starter Katrina
  • Start date Start date
K

Katrina

I have a database set up with a master copy, a front end
and a back end.
The master copy contains all of the info, and is then
exported to the front and back ends periodically.

I have a module set up to export all of the objects
automatically... however, it doesn't export the
relationships. I cannot automatically export the tables
without first using the code to delete them, so I have it
set up to delete them and then replace them.

How can I get this to recognise the relationships also?

Katrina
 
Hi Katrina,

This code will do it:

Where ThatDB is the database you getting your relationships from.

Cheers

Andy

Function ImportRelations(ThisDB As Database, ThatDB As Database) As Integer
'------------------------------------------------------------------
' PURPOSE: Imports relationships where table names and field names
' match.
' ACCEPTS: The name of the external database as a string.
' RETURNS: The number of relationships imported as an integer.
'------------------------------------------------------------------

Dim ThisRel As Relation, ThatRel As Relation
Dim ThisField As Field, ThatField As Field
Dim Cr As String, i As Integer, cnt As Integer, RCount As Integer
Dim j As Integer
Dim ErrBadField As Integer

Cr$ = Chr$(13)
RCount = 0

' Loop through all existing relationships in the external
database.
For i = 0 To ThatDB.Relations.Count - 1
Set ThatRel = ThatDB.Relations(i)

' Create 'ThisRel' using values from 'ThatRel'.
Set ThisRel = ThisDB.CreateRelation(ThatRel.Name, _
ThatRel.Table, ThatRel.ForeignTable, ThatRel.Attributes)

' Set bad field flag to false.
ErrBadField = False

' Loop through all fields in that relation.
For j = 0 To ThatRel.Fields.Count - 1
Set ThatField = ThatRel.Fields(j)

' Create 'ThisField' using values from 'ThatField'.
Set ThisField = ThisRel.CreateField(ThatField.Name)
ThisField.ForeignName = ThatField.ForeignName

' Check for bad fields.
On Error Resume Next
ThisRel.Fields.Append ThisField
If Err <> False Then ErrBadField = True
On Error GoTo 0
Next j

' If any field of this relationship caused an error,
' do not add this relationship.
If ErrBadField = True Then
' Something went wrong with the fields.
' Do not do anything.
Else
' Try to append the relation.
On Error Resume Next
ThisDB.Relations.Append ThisRel
If Err <> False Then
' Something went wrong with the relationship.
' Skip it.
Else
' Keep count of successful imports.
RCount = RCount + 1
End If
On Error GoTo 0
End If
Next i

' Close databases.
'ThisDB.Close
'ThatDB.Close

' Return number of successful imports.
ImportRelations = RCount

End Function
 
Thanks for the help.

I have one more question. Can this be done with an export
instead?

Thanks,
Katrina
 
Back
Top