Discussion :

[Younes]

Bonjour a tous,
dans ma db, j'ai un bouton qui me permet d'exporter toutes mes tables vers differents fichiers excells.
Et j'ai un autre bouton qui me permet d'importer tout les fichiers excells vers mes tables.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Private Sub B_Export_Click()
     Dim tbl As TableDef
    For Each tbl In CurrentDb.TableDefs
 
        If Not Mid(tbl.Name, 1, 4) = "MSYS" Then
            'MsgBox tbl.Name
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, tbl.Name, "Chemin\" & tbl.Name, True
        End If
    Next tbl
    DoCmd.Close acForm, "F_Backup"
    DoCmd.OpenForm "Entree administration", , , , , acDialog
End Sub

Pour l'import, il suffit de remplacer l'acExport par ecImport.
A l'export, pas de problemes.
A l'import, comme vous vous en doutez, les tables ne sont pas importé dans un ordre adapté (Integrité referentielle). Je perds donc un tas d'enregistrements.
Est ce que il existe un moyen dynamique de connaitre les relations entre les tables afin que l'import se passe sans probleme, ou est ce que je dois coder l'ordre d'import et perdre le dynamisme?

Voila, merci d'avance à tous.

[littleCoucou]

ben t'as plusieurs solutions : soit tu importe avec trasnferSpreadsheet dans une table temporaire, puis tu codes ensuite toi même le transfert ordonnée des données vers ta table de production, soit tu fait comme je l'ai fait il y a longtemps dans une appli, c'est un peu barbare mais ca marche : tu casses la relation, tu importes tes données , tu vérifies tes intégrités, et si c'est ok tu remets la relation.

[Younes]

Excellent, casser les relations c'est exactement ce qu'il me faut.
Est ce que tu aurais un exemple? En attendant, je fais ma petite recherche.
En tout cas, merci beaucoup.

Des fois on se demande comment on fais pour pas y penser soi meme

[cafeine]

un exemple de code pour vider tes relations

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Function XDropRelations()
Dim Rel As Relation
For Each Rel In CurrentDb.Relations
    Debug.Print "effacement de la relation [" & Rel.Table & "]![" & Rel.Fields(0).name & "] -=-> [" & Rel.ForeignTable & "]![" & Rel.Fields(0).ForeignName & "]"
    CurrentDb.Relations.Delete Rel.name
Next Rel
 
End Function

[Younes]

Merci cafeine,
c'est exactement ce qu'il me faut. Je vais le tester de ce pas.
Encore une question.
Une fois que les relations sont effacées, est ce que il existe un moyen de les reactiver simplement (I'm dreaming ). Ou est ce que je dois creer l'inverse de ta routine, c-a-d, une routine qui crée les relations entre les tables.


En tout cas merci pour votre aide precieuse.

[cafeine]

stocke les dans une table ou fichier avant effacement.

[Younes]

Merci pour ton aide Cafeine,
je m'excuse de ne pas avoir pu repondre plus tôt.
J'ai suivi ton idée et voici le code qui en resulte.
Je vide mes tables, j'efface toutes les relations, j'importe les données des fichiers excells, et je recrée mes relations:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Private Sub B_Import_Click()
'importation des fichiers excells vers les tables access
    Dim tbl As TableDef
    emptyTables
    dropRelations
    For Each tbl In CurrentDb.TableDefs
 
        If Not Mid(tbl.Name, 1, 4) = "MSYS" Then
            MsgBox tbl.Name
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, tbl.Name, "E:\Projet\Back-up DB\" & tbl.Name, True
        End If
    Next tbl
 
    createRelations
    'DoCmd.Close acForm, "F_Backup"
    'DoCmd.OpenForm "Entree administration", , , , , acDialog
 
End Sub

Methode qui efface les relations et stocke les relations dans une table temporaire.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
 
Private Sub dropRelations()
'les relations sont enregistrées dans un table temporaire
Dim rel As Relation
Dim sqlString As String
 
sqlString = "Create table temp (relationName varchar(30),tableName varchar(30),relForeignTable varchar(30),relAttributes varchar (30))"
DoCmd.RunSQL sqlString
For Each rel In CurrentDb.Relations
      sqlString = "Insert into temp values ('" & rel.Name & "', '" & rel.Table & "', '" & _
                                    rel.ForeignTable & "','" & rel.Attributes & "')"
    DoCmd.SetWarnings (False)
        DoCmd.RunSQL sqlString
    DoCmd.SetWarnings (True)
 
    CurrentDb.Relations.Delete rel.Name
Next rel
 
End Sub

Methode qui recupere les relations stockées dans la table temp et recree les relations.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Private Sub createRelations()
 
    Dim db As Database
    Dim rel As Relation
    Dim sqlString As String
    Dim rs As DAO.Recordset
 
 
    Set db = Application.CurrentDb
    sqlString = "Select * from temp"
    Set rs = db.OpenRecordset(sqlString)
    If Not rs.EOF Then
 
        rs.MoveFirst
        While Not rs.EOF
            Set rel = db.CreateRelation(rs.Fields("relationName"), rs.Fields("tableName"), rs.Fields("relForeignTable"), rs.Fields("relAttributes"))
            CurrentDb.Relations.Append rel
        rs.MoveNext
        Wend
    End If
 
    'sqlString = "Drop table temp "
    'DoCmd.RunSQL sqlString
End Sub

Voila,
J'ai regardé dans l'aide access comment creer une relation a l'aide de la methode createRelation. Avant d'effacer une relation, je recupere toutes les infos necessaire et je les stocke dans une table temporaire.

Tout à l'air de bien fonctionner, sauf qu'apres l'execution du code, mes relations n'apparaisse plus.
Je les ai pourtant créé et ajouter a la collection de relations. Est ce que j'ai manqué quelquechose?
Voila merci d'avance pour toute aide.

[Younes]

C'est remoi,

J'ai reussi a faire apparaitre mes relations en modifiant mon code de cette maniere:
La methode qui efface les relations:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Private Sub dropRelations()
'Cette fonction efface toutes les relations entre les tables
'Vu que lorsque l'on insere, on insere pas dans l'ordre
'les relations sont enregistrées dans un table temporaire
Dim rel As Relation
Dim sqlString As String
'sqlString = "drop table temp"
'DoCmd.RunSQL sqlString
sqlString = "Create table TempRelations (relationName varchar(30),tableName varchar(30), " & _
            " relForeignTable varchar(30),relAttributes varchar (30), " & _
            " relField varchar(30), relForeignField varchar(30))"
DoCmd.RunSQL sqlString
For Each rel In CurrentDb.Relations
    'MsgBox "effacement de la relation [" & rel.Table & "]![" & rel.Fields(0).Name & "] -=-> [" & rel.ForeignTable & "]![" & rel.Fields(0).ForeignName & "]"
    sqlString = "Insert into TempRelations 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

La methode qui cree les relations:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
 
Private Sub createRelations()
 
    Dim db As Database
    Dim rel As Relation
    Dim myField As dao.Field
    Dim sqlString As String
    Dim rs As dao.Recordset
    Dim cpt As Integer
    cpt = 0
 
    Set db = Application.CurrentDb
    sqlString = "Select * from TempRelations"
    Set rs = db.OpenRecordset(sqlString)
    If Not rs.EOF Then
        cpt = cpt + 1
        MsgBox cpt
        rs.MoveFirst
        While Not rs.EOF
            Set rel = db.CreateRelation(rs.Fields("relationName"), rs.Fields("tableName"), rs.Fields("relForeignTable"), rs.Fields("relAttributes"))
            Set myField = rel.CreateField(rs.Fields("relField"))
            myField.ForeignName = rs.Fields("relForeignField")
            rel.Fields.Append myField
            CurrentDb.Relations.Append rel
        rs.MoveNext
        Wend
    End If
 
    'sqlString = "Drop table temp "
    'DoCmd.RunSQL sqlString
End Sub

Voila, j'espere que cela servira a quelqu'un d'autre.
Merci a tous

[Christian_59]

C'est remoi,

J'ai reussi a faire apparaitre mes relations en modifiant mon code de cette maniere:
La methode qui efface les relations:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Private Sub dropRelations()
'Cette fonction efface toutes les relations entre les tables
'Vu que lorsque l'on insere, on insere pas dans l'ordre
'les relations sont enregistrées dans un table temporaire
Dim rel As Relation
Dim sqlString As String
'sqlString = "drop table temp"
'DoCmd.RunSQL sqlString
sqlString = "Create table TempRelations (relationName varchar(30),tableName varchar(30), " & _
            " relForeignTable varchar(30),relAttributes varchar (30), " & _
            " relField varchar(30), relForeignField varchar(30))"
DoCmd.RunSQL sqlString
For Each rel In CurrentDb.Relations
    'MsgBox "effacement de la relation [" & rel.Table & "]![" & rel.Fields(0).Name & "] -=-> [" & rel.ForeignTable & "]![" & rel.Fields(0).ForeignName & "]"
    sqlString = "Insert into TempRelations 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

La methode qui cree les relations:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
 
Private Sub createRelations()
 
    Dim db As Database
    Dim rel As Relation
    Dim myField As dao.Field
    Dim sqlString As String
    Dim rs As dao.Recordset
    Dim cpt As Integer
    cpt = 0
 
    Set db = Application.CurrentDb
    sqlString = "Select * from TempRelations"
    Set rs = db.OpenRecordset(sqlString)
    If Not rs.EOF Then
        cpt = cpt + 1
        MsgBox cpt
        rs.MoveFirst
        While Not rs.EOF
            Set rel = db.CreateRelation(rs.Fields("relationName"), rs.Fields("tableName"), rs.Fields("relForeignTable"), rs.Fields("relAttributes"))
            Set myField = rel.CreateField(rs.Fields("relField"))
            myField.ForeignName = rs.Fields("relForeignField")
            rel.Fields.Append myField
            CurrentDb.Relations.Append rel
        rs.MoveNext
        Wend
    End If
 
    'sqlString = "Drop table temp "
    'DoCmd.RunSQL sqlString
End Sub

Voila, j'espere que cela servira a quelqu'un d'autre.
Merci a tous