Rétablir les relations à partir de la Base Frontale

Le
Jacques
Bonjour,

Ce code fonctionne pour rétablir les relations sur les tables d'une
base locale,
comment le modifier pour le faire fonctionner à partir d'une base
frontale ?
est-ce possible de rétablir des relations sur une base attachée ?

Sub CreationRelations()

Dim db As Database
Dim rel As Relation
Dim myField As DAO.Field
Dim strsql As String
Dim rs As DAO.Recordset
Dim cpt As Integer
cpt = 0

Set db = Application.CurrentDb
strsql = "Select * from [tbl Relations]"
Set rs = db.OpenRecordset(strsql)
If Not rs.EOF Then
cpt = cpt + 1
'MsgBox cpt
rs.MoveFirst
While Not rs.EOF
Set rel = db.CreateRelation(rs.Fields("NomRelation"),
rs.Fields("TablePrincipale"), rs.Fields("TableSecondaire"), rs.Fields
("relAttributes"))
Set myField = rel.CreateField(rs.Fields("ChampPrincipal"))
myField.ForeignName = rs.Fields("ChampSecondaire")
rel.Fields.Append myField
CurrentDb.Relations.Append rel
rs.MoveNext
Wend
End If
End Sub

Merci de votre aide.

Salutations
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
CErnst
Le #18954841
Dim ws As Workspace, db As Database
Set ws = DBEngine.CreateWorkspace("Nouveau", "user", "password", dbUseJet)
Set db = ws.OpenDatabase("C:RépertoireBaseDeDonnées.mdb")
...
votre programme
....
db.close : set db=nothing
ws.close : set ws = nothing




"Jacques"
Bonjour,

Ce code fonctionne pour rétablir les relations sur les tables d'une
base locale,
comment le modifier pour le faire fonctionner à partir d'une base
frontale ?
est-ce possible de rétablir des relations sur une base attachée ?

Sub CreationRelations()

Dim db As Database
Dim rel As Relation
Dim myField As DAO.Field
Dim strsql As String
Dim rs As DAO.Recordset
Dim cpt As Integer
cpt = 0

Set db = Application.CurrentDb
strsql = "Select * from [tbl Relations]"
Set rs = db.OpenRecordset(strsql)
If Not rs.EOF Then
cpt = cpt + 1
'MsgBox cpt
rs.MoveFirst
While Not rs.EOF
Set rel = db.CreateRelation(rs.Fields("NomRelation"),
rs.Fields("TablePrincipale"), rs.Fields("TableSecondaire"), rs.Fields
("relAttributes"))
Set myField = rel.CreateField(rs.Fields("ChampPrincipal"))
myField.ForeignName = rs.Fields("ChampSecondaire")
rel.Fields.Append myField
CurrentDb.Relations.Append rel
rs.MoveNext
Wend
End If
End Sub

Merci de votre aide.

Salutations
jacques
Le #18956521
On 22 mar, 13:13, "CErnst"
Dim ws As Workspace, db As Database
Set ws = DBEngine.CreateWorkspace("Nouveau", "user", "password", dbUseJ et)
Set db = ws.OpenDatabase("C:RépertoireBaseDeDonnées.mdb")
...
votre programme
....
db.close : set db=nothing
ws.close : set ws = nothing

"Jacques"
Bonjour,

Ce code fonctionne pour rétablir les relations sur les tables d'une
base locale,
comment le modifier pour le faire fonctionner à partir d'une base
frontale ?
est-ce possible de rétablir des relations sur une base attachée ?

Sub CreationRelations()

    Dim db As Database
    Dim rel As Relation
    Dim myField As DAO.Field
    Dim strsql As String
    Dim rs As DAO.Recordset
    Dim cpt As Integer
    cpt = 0

    Set db = Application.CurrentDb
    strsql = "Select * from [tbl Relations]"
    Set rs = db.OpenRecordset(strsql)
    If Not rs.EOF Then
        cpt = cpt + 1
        'MsgBox cpt
        rs.MoveFirst
        While Not rs.EOF
            Set rel = db.CreateRelation(rs.Fields("NomRelat ion"),
rs.Fields("TablePrincipale"), rs.Fields("TableSecondaire"), rs.Fields
("relAttributes"))
            Set myField = rel.CreateField(rs.Fields("ChampP rincipal"))
            myField.ForeignName = rs.Fields("ChampSecondair e")
            rel.Fields.Append myField
            CurrentDb.Relations.Append rel
        rs.MoveNext
        Wend
    End If
 End Sub

Merci de votre aide.

Salutations



Bonjour CErnst,

Merci pour ta réponse, mais j'ai un problème sur "user" et "password";
j'ai essayé en les remplaçants par des quotes "" aucun résultat.
Est-il possible de zapper ces deux éléments ?.

Salutations
jacques
Le #18956971
On 22 mar, 17:44, jacques
On 22 mar, 13:13, "CErnst"




> Dim ws As Workspace, db As Database
> Set ws = DBEngine.CreateWorkspace("Nouveau", "user", "password", dbUs eJet)
> Set db = ws.OpenDatabase("C:RépertoireBaseDeDonnées.mdb")
> ...
> votre programme
> ....
> db.close : set db=nothing
> ws.close : set ws = nothing

> "Jacques" >
> Bonjour,

> Ce code fonctionne pour rétablir les relations sur les tables d'une
> base locale,
> comment le modifier pour le faire fonctionner à partir d'une base
> frontale ?
> est-ce possible de rétablir des relations sur une base attachée ?

> Sub CreationRelations()

>     Dim db As Database
>     Dim rel As Relation
>     Dim myField As DAO.Field
>     Dim strsql As String
>     Dim rs As DAO.Recordset
>     Dim cpt As Integer
>     cpt = 0

>     Set db = Application.CurrentDb
>     strsql = "Select * from [tbl Relations]"
>     Set rs = db.OpenRecordset(strsql)
>     If Not rs.EOF Then
>         cpt = cpt + 1
>         'MsgBox cpt
>         rs.MoveFirst
>         While Not rs.EOF
>             Set rel = db.CreateRelation(rs.Fields("NomRel ation"),
> rs.Fields("TablePrincipale"), rs.Fields("TableSecondaire"), rs.Fields
> ("relAttributes"))
>             Set myField = rel.CreateField(rs.Fields("Cham pPrincipal"))
>             myField.ForeignName = rs.Fields("ChampSeconda ire")
>             rel.Fields.Append myField
>             CurrentDb.Relations.Append rel
>         rs.MoveNext
>         Wend
>     End If
>  End Sub

> Merci de votre aide.

> Salutations

Bonjour CErnst,

Merci pour ta réponse, mais j'ai un problème sur "user" et "password" ;
j'ai essayé en les remplaçants par des quotes "" aucun résultat.
Est-il possible de zapper ces deux éléments ?.

Salutations- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -



Re bonjour,

J'ai ecrit la ligne de cette façons, et elle passe, Est-elle
correcte ?

Set ws = DBEngine.CreateWorkspace("Nouveau", "Admin", "", dbUseJet)
Set db = ws.OpenDatabase(strCheminBd)

strCheminBd doit bien être le chemin de la base dorsale ?

Le code se poursuit et j'ai l'erreur d'exécution 3047 Opération non
gérée sur les tables attachées sur cette ligne :

CurrentDb.Relations.Append rel

Salutations
CErnst
Le #18957811
Vous avez un problème de repérage de vos objets.
Il ne faut pas créer la relation dans Currentdb mais dans db, currentdb
étant la base dans laquelle le programme s'exécute (base courante).
Il faut dons créer la relation là où sont effectivement les tables, c'est à
dire l'objet Db.rs :

Db.Relations.Append rel

puisque rs est ouvert sur db et rel crée sur db
soit :

Sub CreationRelations()
Dim db As Database
Dim rel As Relation
Dim myField As DAO.Field
Dim strsql As String
Dim rs As DAO.Recordset
Dim cpt As Integer
Dim Ws as Workspace
Set ws = DBEngine.CreateWorkspace("Nouveau", "Admin", "", dbUseJet)
Set db = ws.OpenDatabase(strCheminBd)

cpt = 0
strsql = "Select * from [tbl Relations]"
Set rs = db.OpenRecordset(strsql)
If Not rs.EOF Then
cpt = cpt + 1
rs.MoveFirst
While Not rs.EOF
Set rel = db.CreateRelation(rs.Fields("NomRelation"),
rs.Fields("TablePrincipale"), rs.Fields("TableSecondaire"),
rs.Fields("relAttributes"))
Set myField = rel.CreateField(rs.Fields("ChampPrincipal"))
myField.ForeignName = rs.Fields("ChampSecondaire")
rel.Fields.Append myField
Db.Relations.Append rel
rs.MoveNext
Wend
End If
End Sub



"jacques"
On 22 mar, 17:44, jacques
On 22 mar, 13:13, "CErnst"




> Dim ws As Workspace, db As Database
> Set ws = DBEngine.CreateWorkspace("Nouveau", "user", "password",
> dbUseJet)
> Set db = ws.OpenDatabase("C:RépertoireBaseDeDonnées.mdb")
> ...
> votre programme
> ....
> db.close : set db=nothing
> ws.close : set ws = nothing

> "Jacques" >
> Bonjour,

> Ce code fonctionne pour rétablir les relations sur les tables d'une
> base locale,
> comment le modifier pour le faire fonctionner à partir d'une base
> frontale ?
> est-ce possible de rétablir des relations sur une base attachée ?

> Sub CreationRelations()

> Dim db As Database
> Dim rel As Relation
> Dim myField As DAO.Field
> Dim strsql As String
> Dim rs As DAO.Recordset
> Dim cpt As Integer
> cpt = 0

> Set db = Application.CurrentDb
> strsql = "Select * from [tbl Relations]"
> Set rs = db.OpenRecordset(strsql)
> If Not rs.EOF Then
> cpt = cpt + 1
> 'MsgBox cpt
> rs.MoveFirst
> While Not rs.EOF
> Set rel = db.CreateRelation(rs.Fields("NomRelation"),
> rs.Fields("TablePrincipale"), rs.Fields("TableSecondaire"), rs.Fields
> ("relAttributes"))
> Set myField = rel.CreateField(rs.Fields("ChampPrincipal"))
> myField.ForeignName = rs.Fields("ChampSecondaire")
> rel.Fields.Append myField
> CurrentDb.Relations.Append rel
> rs.MoveNext
> Wend
> End If
> End Sub

> Merci de votre aide.

> Salutations

Bonjour CErnst,

Merci pour ta réponse, mais j'ai un problème sur "user" et "password";
j'ai essayé en les remplaçants par des quotes "" aucun résultat.
Est-il possible de zapper ces deux éléments ?.

Salutations- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -



Re bonjour,

J'ai ecrit la ligne de cette façons, et elle passe, Est-elle
correcte ?

Set ws = DBEngine.CreateWorkspace("Nouveau", "Admin", "", dbUseJet)
Set db = ws.OpenDatabase(strCheminBd)

strCheminBd doit bien être le chemin de la base dorsale ?

Le code se poursuit et j'ai l'erreur d'exécution 3047 Opération non
gérée sur les tables attachées sur cette ligne :

CurrentDb.Relations.Append rel

Salutations
jacques
Le #18966401
On 22 mar, 21:01, "CErnst"
Vous avez un problème de repérage de vos objets.
Il ne faut pas créer la relation dans Currentdb mais dans db, currentdb
étant la base dans laquelle le programme s'exécute (base courante).
Il faut dons créer la relation là où sont effectivement les tables, c'est à
dire l'objet Db.rs :

Db.Relations.Append rel

puisque rs est ouvert sur db et rel crée sur db
soit :

Sub CreationRelations()
       Dim db As Database
       Dim rel As Relation
       Dim myField As DAO.Field
       Dim strsql As String
       Dim rs As DAO.Recordset
       Dim cpt As Integer
       Dim Ws as Workspace
       Set ws = DBEngine.CreateWorkspace("Nouveau", "Admin", "" , dbUseJet)
       Set db = ws.OpenDatabase(strCheminBd)

      cpt = 0
      strsql = "Select * from [tbl Relations]"
      Set rs = db.OpenRecordset(strsql)
      If Not rs.EOF Then
         cpt = cpt + 1
         rs.MoveFirst
         While Not rs.EOF
                 Set rel = db.CreateRelation(rs.Field s("NomRelation"),
                 rs.Fields("TablePrincipale"), rs.Field s("TableSecondaire"),
rs.Fields("relAttributes"))
                 Set myField = rel.CreateField(rs.Fie lds("ChampPrincipal"))
                 myField.ForeignName = rs.Fields("Cha mpSecondaire")
                 rel.Fields.Append myField
                 Db.Relations.Append rel
                 rs.MoveNext
        Wend
     End If
End Sub

"jacques"
On 22 mar, 17:44, jacques




> On 22 mar, 13:13, "CErnst"
> > Dim ws As Workspace, db As Database
> > Set ws = DBEngine.CreateWorkspace("Nouveau", "user", "password",
> > dbUseJet)
> > Set db = ws.OpenDatabase("C:RépertoireBaseDeDonnées.mdb")
> > ...
> > votre programme
> > ....
> > db.close : set db=nothing
> > ws.close : set ws = nothing

> > "Jacques" > >
> > Bonjour,

> > Ce code fonctionne pour rétablir les relations sur les tables d'une
> > base locale,
> > comment le modifier pour le faire fonctionner à partir d'une base
> > frontale ?
> > est-ce possible de rétablir des relations sur une base attachée ?

> > Sub CreationRelations()

> > Dim db As Database
> > Dim rel As Relation
> > Dim myField As DAO.Field
> > Dim strsql As String
> > Dim rs As DAO.Recordset
> > Dim cpt As Integer
> > cpt = 0

> > Set db = Application.CurrentDb
> > strsql = "Select * from [tbl Relations]"
> > Set rs = db.OpenRecordset(strsql)
> > If Not rs.EOF Then
> > cpt = cpt + 1
> > 'MsgBox cpt
> > rs.MoveFirst
> > While Not rs.EOF
> > Set rel = db.CreateRelation(rs.Fields("NomRelation"),
> > rs.Fields("TablePrincipale"), rs.Fields("TableSecondaire"), rs.Fields
> > ("relAttributes"))
> > Set myField = rel.CreateField(rs.Fields("ChampPrincipal"))
> > myField.ForeignName = rs.Fields("ChampSecondaire")
> > rel.Fields.Append myField
> > CurrentDb.Relations.Append rel
> > rs.MoveNext
> > Wend
> > End If
> > End Sub

> > Merci de votre aide.

> > Salutations

> Bonjour CErnst,

> Merci pour ta réponse, mais j'ai un problème sur "user" et "passwor d";
> j'ai essayé en les remplaçants par des quotes "" aucun résultat.
> Est-il possible de zapper ces deux éléments ?.

> Salutations- Masquer le texte des messages précédents -

> - Afficher le texte des messages précédents -

Re bonjour,

J'ai ecrit la ligne de cette façons, et elle passe, Est-elle
correcte ?

Set ws = DBEngine.CreateWorkspace("Nouveau", "Admin", "", dbUseJet)
Set db = ws.OpenDatabase(strCheminBd)

strCheminBd doit bien être le chemin de la base dorsale ?

Le code se poursuit et j'ai l'erreur d'exécution 3047 Opération non
gérée sur les tables attachées sur cette ligne :

 CurrentDb.Relations.Append rel

Salutations- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -



Bonsoir CErnst,

Merci pour le code modifier est tes explications très utile.

Pour effacer mes relations j'utilise ce code et je voudrais
l'intégrer
à la procédure rétablir les liaisons. Est-ce possible ?

Private Sub SupprimerRelations()
Dim rel As Relation
Dim sqlString As String

sqlString = "Create table [tbl Relations] (NomRelation varchar
(200),TablePrincipale varchar(30), " & _
"TableSecondaire varchar(30),relAttributes varchar (30), "
& _
"ChampPrincipal varchar(30), ChampSecondaire varchar(30))"
DoCmd.RunSQL sqlString

For Each rel In CurrentDb.Relations
sqlString = "Insert into [tbl Relations] values ('" & rel.Name &
"', '" & rel.Table & "', '" & _
rel.ForeignTable & "','" &
rel.Attributes & "','" & _
rel.Fields(0).Name & "','" &
rel.Fields(0).ForeignName & "')"
DoCmd.SetWarnings (False)
DoCmd.RunSQL sqlString
DoCmd.SetWarnings (True)

CurrentDb.Relations.Delete rel.Name
Next rel

End Sub

Merci pour ton aide.

Salutations
CErnst
Le #18969171
Il y a plus simple pour supprimer les relations :

Dim WS as workspace, DB As Database,pr%
Set ws = DBEngine.CreateWorkspace("Nouveau", "Admin", "", dbUseJet)
Set db = ws.OpenDatabase(strCheminBd)

On Error Resume Next
While DB.Relations.Count > 0
DB.Relations.Delete DB.Relations(0).Name
Wend
db.close: set db=nothing
set ws=nothing






"jacques"
On 22 mar, 21:01, "CErnst"
Vous avez un problème de repérage de vos objets.
Il ne faut pas créer la relation dans Currentdb mais dans db, currentdb
étant la base dans laquelle le programme s'exécute (base courante).
Il faut dons créer la relation là où sont effectivement les tables, c'est
à
dire l'objet Db.rs :

Db.Relations.Append rel

puisque rs est ouvert sur db et rel crée sur db
soit :

Sub CreationRelations()
Dim db As Database
Dim rel As Relation
Dim myField As DAO.Field
Dim strsql As String
Dim rs As DAO.Recordset
Dim cpt As Integer
Dim Ws as Workspace
Set ws = DBEngine.CreateWorkspace("Nouveau", "Admin", "", dbUseJet)
Set db = ws.OpenDatabase(strCheminBd)

cpt = 0
strsql = "Select * from [tbl Relations]"
Set rs = db.OpenRecordset(strsql)
If Not rs.EOF Then
cpt = cpt + 1
rs.MoveFirst
While Not rs.EOF
Set rel = db.CreateRelation(rs.Fields("NomRelation"),
rs.Fields("TablePrincipale"), rs.Fields("TableSecondaire"),
rs.Fields("relAttributes"))
Set myField = rel.CreateField(rs.Fields("ChampPrincipal"))
myField.ForeignName = rs.Fields("ChampSecondaire")
rel.Fields.Append myField
Db.Relations.Append rel
rs.MoveNext
Wend
End If
End Sub

"jacques"
On 22 mar, 17:44, jacques




> On 22 mar, 13:13, "CErnst"
> > Dim ws As Workspace, db As Database
> > Set ws = DBEngine.CreateWorkspace("Nouveau", "user", "password",
> > dbUseJet)
> > Set db = ws.OpenDatabase("C:RépertoireBaseDeDonnées.mdb")
> > ...
> > votre programme
> > ....
> > db.close : set db=nothing
> > ws.close : set ws = nothing

> > "Jacques" > >
> > Bonjour,

> > Ce code fonctionne pour rétablir les relations sur les tables d'une
> > base locale,
> > comment le modifier pour le faire fonctionner à partir d'une base
> > frontale ?
> > est-ce possible de rétablir des relations sur une base attachée ?

> > Sub CreationRelations()

> > Dim db As Database
> > Dim rel As Relation
> > Dim myField As DAO.Field
> > Dim strsql As String
> > Dim rs As DAO.Recordset
> > Dim cpt As Integer
> > cpt = 0

> > Set db = Application.CurrentDb
> > strsql = "Select * from [tbl Relations]"
> > Set rs = db.OpenRecordset(strsql)
> > If Not rs.EOF Then
> > cpt = cpt + 1
> > 'MsgBox cpt
> > rs.MoveFirst
> > While Not rs.EOF
> > Set rel = db.CreateRelation(rs.Fields("NomRelation"),
> > rs.Fields("TablePrincipale"), rs.Fields("TableSecondaire"), rs.Fields
> > ("relAttributes"))
> > Set myField = rel.CreateField(rs.Fields("ChampPrincipal"))
> > myField.ForeignName = rs.Fields("ChampSecondaire")
> > rel.Fields.Append myField
> > CurrentDb.Relations.Append rel
> > rs.MoveNext
> > Wend
> > End If
> > End Sub

> > Merci de votre aide.

> > Salutations

> Bonjour CErnst,

> Merci pour ta réponse, mais j'ai un problème sur "user" et "password";
> j'ai essayé en les remplaçants par des quotes "" aucun résultat.
> Est-il possible de zapper ces deux éléments ?.

> Salutations- Masquer le texte des messages précédents -

> - Afficher le texte des messages précédents -

Re bonjour,

J'ai ecrit la ligne de cette façons, et elle passe, Est-elle
correcte ?

Set ws = DBEngine.CreateWorkspace("Nouveau", "Admin", "", dbUseJet)
Set db = ws.OpenDatabase(strCheminBd)

strCheminBd doit bien être le chemin de la base dorsale ?

Le code se poursuit et j'ai l'erreur d'exécution 3047 Opération non
gérée sur les tables attachées sur cette ligne :

CurrentDb.Relations.Append rel

Salutations- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -



Bonsoir CErnst,

Merci pour le code modifier est tes explications très utile.

Pour effacer mes relations j'utilise ce code et je voudrais
l'intégrer
à la procédure rétablir les liaisons. Est-ce possible ?

Private Sub SupprimerRelations()
Dim rel As Relation
Dim sqlString As String

sqlString = "Create table [tbl Relations] (NomRelation varchar
(200),TablePrincipale varchar(30), " & _
"TableSecondaire varchar(30),relAttributes varchar (30), "
& _
"ChampPrincipal varchar(30), ChampSecondaire varchar(30))"
DoCmd.RunSQL sqlString

For Each rel In CurrentDb.Relations
sqlString = "Insert into [tbl Relations] values ('" & rel.Name &
"', '" & rel.Table & "', '" & _
rel.ForeignTable & "','" &
rel.Attributes & "','" & _
rel.Fields(0).Name & "','" &
rel.Fields(0).ForeignName & "')"
DoCmd.SetWarnings (False)
DoCmd.RunSQL sqlString
DoCmd.SetWarnings (True)

CurrentDb.Relations.Delete rel.Name
Next rel

End Sub

Merci pour ton aide.

Salutations
jacques
Le #18971441
On 24 mar, 13:33, "CErnst"
Il y a plus simple pour supprimer les relations :

   Dim WS as workspace, DB As Database,pr%
   Set ws = DBEngine.CreateWorkspace("Nouveau", "Admin", "", dbUseJ et)
   Set db = ws.OpenDatabase(strCheminBd)

   On Error Resume Next
   While DB.Relations.Count > 0
            DB.Relations.Delete DB.Relations(0).Name
   Wend
   db.close: set db=nothing
   set ws=nothing

"jacques"
On 22 mar, 21:01, "CErnst"




> Vous avez un problème de repérage de vos objets.
> Il ne faut pas créer la relation dans Currentdb mais dans db, current db
> étant la base dans laquelle le programme s'exécute (base courante).
> Il faut dons créer la relation là où sont effectivement les table s, c'est
> à
> dire l'objet Db.rs :

> Db.Relations.Append rel

> puisque rs est ouvert sur db et rel crée sur db
> soit :

> Sub CreationRelations()
> Dim db As Database
> Dim rel As Relation
> Dim myField As DAO.Field
> Dim strsql As String
> Dim rs As DAO.Recordset
> Dim cpt As Integer
> Dim Ws as Workspace
> Set ws = DBEngine.CreateWorkspace("Nouveau", "Admin", "", dbUseJet)
> Set db = ws.OpenDatabase(strCheminBd)

> cpt = 0
> strsql = "Select * from [tbl Relations]"
> Set rs = db.OpenRecordset(strsql)
> If Not rs.EOF Then
> cpt = cpt + 1
> rs.MoveFirst
> While Not rs.EOF
> Set rel = db.CreateRelation(rs.Fields("NomRelation"),
> rs.Fields("TablePrincipale"), rs.Fields("TableSecondaire"),
> rs.Fields("relAttributes"))
> Set myField = rel.CreateField(rs.Fields("ChampPrincipal"))
> myField.ForeignName = rs.Fields("ChampSecondaire")
> rel.Fields.Append myField
> Db.Relations.Append rel
> rs.MoveNext
> Wend
> End If
> End Sub

> "jacques" >
> On 22 mar, 17:44, jacques
> > On 22 mar, 13:13, "CErnst"
> > > Dim ws As Workspace, db As Database
> > > Set ws = DBEngine.CreateWorkspace("Nouveau", "user", "password",
> > > dbUseJet)
> > > Set db = ws.OpenDatabase("C:RépertoireBaseDeDonnées.mdb")
> > > ...
> > > votre programme
> > > ....
> > > db.close : set db=nothing
> > > ws.close : set ws = nothing

> > > "Jacques" > > > .
> > > Bonjour,

> > > Ce code fonctionne pour rétablir les relations sur les tables d'u ne
> > > base locale,
> > > comment le modifier pour le faire fonctionner à partir d'une base
> > > frontale ?
> > > est-ce possible de rétablir des relations sur une base attachée ?

> > > Sub CreationRelations()

> > > Dim db As Database
> > > Dim rel As Relation
> > > Dim myField As DAO.Field
> > > Dim strsql As String
> > > Dim rs As DAO.Recordset
> > > Dim cpt As Integer
> > > cpt = 0

> > > Set db = Application.CurrentDb
> > > strsql = "Select * from [tbl Relations]"
> > > Set rs = db.OpenRecordset(strsql)
> > > If Not rs.EOF Then
> > > cpt = cpt + 1
> > > 'MsgBox cpt
> > > rs.MoveFirst
> > > While Not rs.EOF
> > > Set rel = db.CreateRelation(rs.Fields("NomRelation"),
> > > rs.Fields("TablePrincipale"), rs.Fields("TableSecondaire"), rs.Fiel ds
> > > ("relAttributes"))
> > > Set myField = rel.CreateField(rs.Fields("ChampPrincipal"))
> > > myField.ForeignName = rs.Fields("ChampSecondaire")
> > > rel.Fields.Append myField
> > > CurrentDb.Relations.Append rel
> > > rs.MoveNext
> > > Wend
> > > End If
> > > End Sub

> > > Merci de votre aide.

> > > Salutations

> > Bonjour CErnst,

> > Merci pour ta réponse, mais j'ai un problème sur "user" et "passw ord";
> > j'ai essayé en les remplaçants par des quotes "" aucun résultat .
> > Est-il possible de zapper ces deux éléments ?.

> > Salutations- Masquer le texte des messages précédents -

> > - Afficher le texte des messages précédents -

> Re bonjour,

> J'ai ecrit la ligne de cette façons, et elle passe, Est-elle
> correcte ?

> Set ws = DBEngine.CreateWorkspace("Nouveau", "Admin", "", dbUseJet)
> Set db = ws.OpenDatabase(strCheminBd)

> strCheminBd doit bien être le chemin de la base dorsale ?

> Le code se poursuit et j'ai l'erreur d'exécution 3047 Opération non
> gérée sur les tables attachées sur cette ligne :

> CurrentDb.Relations.Append rel

> Salutations- Masquer le texte des messages précédents -

> - Afficher le texte des messages précédents -

Bonsoir CErnst,

Merci pour le code modifier est tes explications très utile.

Pour effacer mes relations j'utilise ce code et je voudrais
l'intégrer
à la procédure rétablir les liaisons. Est-ce possible ?

Private Sub SupprimerRelations()
Dim rel As Relation
Dim sqlString As String

sqlString = "Create table [tbl Relations] (NomRelation varchar
(200),TablePrincipale varchar(30), " & _
            "TableSecondaire varchar(30),relAttributes varcha r (30), "
& _
            "ChampPrincipal varchar(30), ChampSecondaire varc har(30))"
DoCmd.RunSQL sqlString

For Each rel In CurrentDb.Relations
    sqlString = "Insert into [tbl Relations] values ('" & rel.Name &
"', '" & rel.Table & "', '" & _
                                    r el.ForeignTable & "','" &
rel.Attributes & "','" & _
                                    r el.Fields(0).Name & "','" &
rel.Fields(0).ForeignName & "')"
    DoCmd.SetWarnings (False)
        DoCmd.RunSQL sqlString
    DoCmd.SetWarnings (True)

    CurrentDb.Relations.Delete rel.Name
Next rel

End Sub

Merci pour ton aide.

Salutations- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -



Bonsoir CErnst,

Toutes mes excuses je me suis mal expliquer.

Je voudrais aussi pouvoir utiliser la partie créations de table et le
insert into
avant de supprimer les relations.

Salutations
Publicité
Poster une réponse
Anonyme