Discussion :

[Flo88]

Bonjour j'aimerai réussir à tester si des tables sont déjà attachés. Le code ci après est une fonction que j'exécute dans une macro à l'ouverture. Elle marche à la première utilisation car il n'y a pas de table attaché. Le problème dès la deuxième utilisation elle ajoute, supprime et réajoute mais vu qu'il y a deux fois les meme tables, elle les met en double. ce que je voudrai en algo, ce serait ca :

Code :

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

1
2
3
4
5
6
7
8
9
Si Longueur du Chemin Supérieur à 0 Alors
       Pour Cpt de 1 à NbTables
            Si pas de Tables attachées Alors
                   attachées les tables
            Fsi
        Supprimer toutes les tables
        Attachées les tables
        FPour
FSi

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
33
34
35
36
37
38
39
40
41
42
43
44
45
Function ChargerTable()
 
    Dim TblTables(20)
    Dim NbTables
    Dim Cpt
 
    'DoCmd.OpenForm ("ADMINISTRATION")
 
    TblTables(1) = "DESIGNATION"
    TblTables(2) = "ElementFictif"
    TblTables(3) = "ETAT"
    TblTables(4) = "PARAMETRE_PERS"
    TblTables(5) = "PERSONNE"
    TblTables(6) = "SITE"
    TblTables(7) = "TYPE"
    TblTables(8) = "VETEMENT"
    TblTables(9) = ""
    TblTables(10) = ""
    TblTables(11) = ""
    TblTables(12) = ""
    TblTables(13) = ""
 
    NbTables = 8
 
    Chemin = CurrentProject.Path
 
    If Len(Chemin) > 0 Then
 
        For Cpt = 1 To NbTables
 
            DoCmd.TransferDatabase acLink, "Microsoft Access", "" & Chemin & "\vet_base_ouverture.mdb", acTable, TblTables(Cpt), TblTables(Cpt)
            DoCmd.DeleteObject acTable, TblTables(Cpt)
            DoCmd.TransferDatabase acLink, "Microsoft Access", "" & Chemin & "\vet_base_ouverture.mdb", acTable, TblTables(Cpt), TblTables(Cpt)
 
        Next
 
    Else
 
        MsgBox ("Entrez le chemmin où se trouve la base...")
 
    End If
 
    DoCmd.OpenForm ("PRINCIPAL")
 
End Function

Merci d'avance,
J'espère que vous pourrez m'aider rapidement, je suis sur ce projet depuis trop longtemps déjà

[Jean-Philippe André]

salut,
je te recommande une combinaison de ces deux fonctions :

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
Function PresenceLiaisonMorteDansBase(PathBase As String) As Boolean
Dim Db As DAO.Database
Dim temp As TableDef
Dim rs As DAO.Recordset
    Set Db = DBEngine.OpenDatabase(PathBase)
    On Error GoTo fin
    For Each temp In Db.TableDefs
    Set rs = Db.OpenRecordset("SELECT * FROM [" & temp.Name & "]")
    Next
    PresenceLiaisonMorteDansBase = False
Exit Function
fin:
    PresenceLiaisonMorteDansBase = True
    Debug.Print "Pb liaison table : " & temp.Name
    Resume Next
End Function

et

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
Function ListeTablesLiees(PathBase As String) As Boolean
Dim StrSQL As String
Dim rs As DAO.Recordset
'fonction de recuperation des tables liees dans les bases à traiter
On Error GoTo fin
Debug.Print PathBase
If Dir(PathBase) <> "" Then
'1. copie des valeurs dans la table tempo
    StrSQL = "SELECT Name, ForeignName, Database, Connect, Type FROM MSysObjects IN '" & PathBase & "' WHERE MSysObjects.Type=6 OR MSysObjects.Type=4 OR MSysObjects.Type=-32761;"
    'Debug.Print strSQL
    Set rs = CurrentDb.OpenRecordset(StrSQL)
    ListeTablesLiees = True
End If
Exit Function
fin:
    'TraitementBase = False
    'CurrentDb.Execute "INSERT INTO T_Erreurs (dHoraire, sExecution, sMotif) VALUES (#" & Format(Now, "MM/dd/yyyy hh:mm:ss") & "#,'" & pathbase & "','" & Err.Number & "');"
    Resume Next
End Function

Ca permet de savoir si la table existe d'une part, et de savoir si le lien est mort d'autre part ^^

[Flo88]

je n'ai pas tout compris... Ca donnerait quoi dans mon code ?

[Jean-Philippe André]

dans ton code, il faut que tu fasses un traitement dans cette partie :

Code :

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

1
2
3
4
5
6
7
8
9
10
 If Len(Chemin) > 0 Then
 
        For Cpt = 1 To NbTables
 
            DoCmd.TransferDatabase acLink, "Microsoft Access", "" & Chemin & "\vet_base_ouverture.mdb", acTable, TblTables(Cpt), TblTables(Cpt)
'pourquoi faire toujours un delete ?
            DoCmd.DeleteObject acTable, TblTables(Cpt)
            DoCmd.TransferDatabase acLink, "Microsoft Access", "" & Chemin & "\vet_base_ouverture.mdb", acTable, TblTables(Cpt), TblTables(Cpt)
 
        Next

tu vas pouvoir d'abord tester si des tables sont liées de facon foireuse :

Code :

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

PresenceLiaisonMorteDansBase(currentdb.FullName)

après tu peux tester avec cette autre fonction si la table nommée "DESIGNATION" etc sont bien dans ta base :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Function DoesTableExist(ByVal NomTable As String) As Boolean
    Dim str As String
    On Error GoTo NoTable
    str = CurrentDb.TableDefs(NomTable).Name
    DoesTableExist = True
    Exit Function
NoTable:
    Select Case err.Number
        Case 3265
            DoesTableExist = False
    End Select
End Function

utilisée ainsi

Code :

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

1
2
 
msgbox iif(DoesTableExist("DESIGNATION"),"DESIGNATION existe bien","il n'y a pas de table DESIGNATION dans la base")

[Flo88]

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
    If Len(Chemin) > 0 Then
 
        For Cpt = 1 To NbTables
 
            If Not PresenceLiaisonMorteDansBase(CurrentDb.FullName) Then
            DoCmd.TransferDatabase acLink, "Microsoft Access", "" & Chemin & "\vet_base_ouverture.mdb", acTable, TblTables(Cpt), TblTables(Cpt)
            End If
            DoCmd.DeleteObject acTable, TblTables(Cpt)
            DoCmd.TransferDatabase acLink, "Microsoft Access", "" & Chemin & "\vet_base_ouverture.mdb", acTable, TblTables(Cpt), TblTables(Cpt)
 
        Next
 
    Else
 
        MsgBox ("Entrez le chemmin où se trouve la base...")
 
    End If

j'ai fait ceci mais il bugge sur le .FullName dans le If... ==> Manque de méthode ou de donnée introuvable

[Jean-Philippe André]

pardon, pas besoin de fullname ici, name suffit

[Flo88]

j'ai également tester ceci :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
      For Cpt = 1 To NbTables
 
            'si il y a des tables liées
            If PresenceLiaisonMorteDansBase("" & Chemin & "\vet_base_ouverture.mdb") Then
                DoCmd.DeleteObject acTable
                DoCmd.TransferDatabase acLink, "Microsoft Access", "" & Chemin & "\vet_base_ouverture.mdb", acTable, TblTables(Cpt), TblTables(Cpt)
            Else
                DoCmd.TransferDatabase acLink, "Microsoft Access", "" & Chemin & "\vet_base_ouverture.mdb", acTable, TblTables(Cpt), TblTables(Cpt)
            End If
 
        Next

mais qu'il y ai ou non des tables à chaque ouverture il lie donc toujours le meme problème, à la premiere ouverture ca marche, à la seconde les tables sont en double, à la troisième les tables sont en triples, etc... C'est pour cela qu'il faut que j'arrive à tester s'il y a déjà des tables liées à l'ouverture

[Jean-Philippe André]

ok ok, bon alors voila comment moi j'aurais codé l'idée :

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
 TblTables(1) = "DESIGNATION"
    TblTables(2) = "ElementFictif"
    TblTables(3) = "ETAT"
    TblTables(4) = "PARAMETRE_PERS"
    TblTables(5) = "PERSONNE"
    TblTables(6) = "SITE"
    TblTables(7) = "TYPE"
    TblTables(8) = "VETEMENT"
for i = 1 to 8
If DoesTableExist(TblTables(i)) Then
'oui ma table existe bien dans ma base
Else
'cas où ma table n'existe pas donc je la relie.
DoCmd.TransferDatabase acLink, "Microsoft Access", "" & Chemin & "\vet_base_ouverture.mdb", acTable, TblTables(i), TblTables(i)
 
 
End If

[Flo88]

j'ai également tester cela qui me parraisait plus juste mais même marche quand meme pas :

Code :

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

1
2
3
4
5
        If Not PresenceLiaisonMorteDansBase("" & Chemin & "\vet_base_ouverture.mdb") Then
            For Cpt = 1 To NbTables
                DoCmd.TransferDatabase acLink, "Microsoft Access", "" & Chemin & "\vet_base_ouverture.mdb", acTable, TblTables(Cpt), TblTables(Cpt)
            Next
        End If

[Flo88]

Ca a l'air de marcher
Merci beaucoup
Je fais deux trois tests dans l'aprem et te tiens au jus
En tous cas merci en attendant
Je suis vraiment nul...