[kapetang]

Καλημέρα

Λευτέρη καλωσόρισες στην παρέα του φόρουμ.

Δοκίμασε τον παρακάτω κώδικα.

Function MakeRelJetADO()
'Purpose:   Create a Cascade-to-Null relation using DDL.
    On Error GoTo Err_Trap
    Dim strSql As String
    Dim cnn As New adodb.Connection
    Dim Mycnn As String
    
    
   'Να αντικατασταθεί με το πλήρες πραγματικό όνομα της εξωτερικής βάσης
    Mycnn = CurrentProject.Path & "\" & "CascadeToNull_παρ.mdb"

    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open Mycnn
    End With

    strSql = "ALTER TABLE tblProduct ADD CONSTRAINT tblCategorytblProduct " & _
             "FOREIGN KEY (CategoryID) REFERENCES " & _
             "tblCategory (CategoryID) ON update cascade on DELETE cascade"
    cnn.Execute strSql
Err_Trap:
    If Err.Number <> 0 Then
        If Err.Number = -2147217900 Then
            MsgBox "Υπάρχει ένας περιορισμός ακεραιότητας με όνομα tblCategorytblProduct "
        Else
            MsgBox "Error: " & Err.Number & vbCrLf & _
                    Err.Description
        End If
    Else
        MsgBox "Constraint created"
    End If
    On Error Resume Next
    cnn.Close: Set cnn = Nothing
End Function

Function RelationExists(strRelName As String) As Boolean
    'Purpose:   Return True if the relation already exists.
    Dim db As Database
    Dim strFullNameDB As String
    strFullNameDB = CurrentProject.Path & "\" & "CascadeToNull_παρ.mdb"
    Set db = Workspaces(0).OpenDatabase(strFullNameDB)
    On Error Resume Next
    Debug.Print CurrentDb.Relations(strRelName).Attributes
    RelationExists = (Err.Number = 0&)
    db.Close: Set db = Nothing
End Function

Ο κώδικας, όπως είναι, θα λειτουργήσει αν και οι δύο βάσεις είναι στον ίδιο φάκελο.

Αν είναι σε διαφορετικό θα πρέπει να αλλάξεις στον κώδικα το πλήρες όνομα της εξωτερικής βάσης.

Φιλικά/Γιώργος