ACC: Utilizzo di DAO in codice Visual Basic per l'Importazione relazioni

      Function ImportRelations (DbName As String) 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 ThisDb As Database, ThatDB As Database
      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

      Set ThisDb = CurrentDB()
      Set ThatDB = DBEngine.Workspaces(0).OpenDatabase(DbName$)

      ' 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