Discussion :

[marot_r]

Bonjour à tous et merci de votre aide et de votre temps.

J'ai une application avec une trentaine de tables.
Ces tables comportent un ou plusieurs indexes uniques (ex : CodeComptable, CodePourTransmissionExterne, NomDepartement).
J'ai fais un bon paquet de formulaire pour faire des saisies sur ces tables, une grosse part via des requêtes.

Comme j'ai plusieurs indexes uniques, lorsque j'ai une erreur 3022 (clef dupliquée) je ne sais pas précisément quel est ou quels sont les indexes en double.
Donc j'aimerai faire du code qui valide si un ou plusieurs indexes sont en conflit te mettre un joli message détaillant le problème.
Sauf que je n'arrive pas a trouver un moyen de savoir quels sont les indexes à contrôler.

J'ai trouvé du code pour le faire sur un objet table mais pas sur un objet requête,

J'ai pensé à analyser le SQL de la requête pour extraire les tables et en déduire les indexes mais mes noms de champs dans mon formulaire ne sont pas forcément ceux des tables.
Donc non seulement il faut trouver les tables mais il faut aussi faire la liaison entre les noms de champs dans la table et les nom des champs dans le formulaire ... pas cool.

Je pourrais bien sur faire un inventaire manuel des indexes par formulaire mais je trouve cela assez lourd à faire et surtout à maintenir.

Est-ce que quelqu'un a déjà fait du code dynamique pour gérer cela.

A+

[Invité]

Bonjour,
Effectivement Si tu fais une requête avec un trentaine de tables, il n'est pas impossible que tu est des indexes en doublon!

Mais pour un requête de sélection, pour la lecture c'est gênant mais ça ne pose bien évidemment pass de problème !

En revanche si le but est d'enrichir d'enrichir une autre table là les doublons d'index pas cool!

Mais peut être ne s'agit il pas de doublon a proprement parlé mais d'un champ qui porterait le même nom que ton auto incrément par exemple!

As tu créé le schéma relationnel de ta base avec ses contraintes la tu ne pourrais pas avoir ce problème!
Le fait de le créer te donnerai la réponse car tu serais dans l'impossibilité de créer une contrainte aberrante!



Par définition un clé unique...

As tu mis un distinct dans ton select?

En soit plus tu disposes de liens entre tes tables plus la close where ce complique car un id d'une table peut donner plus valeur et même des nulle comme choisir le bon?

Peut être fais tu un requête d'ajout qui ne tient pas compte de l'existant et là oui! Dans ce cas l'ajout ce fait à partir d'une requête de non correspondance.

Est il possible que ta clé primaire soit un clé multiple sur trois champs par exemple et là ce qui importe ce n'est pas que chaque champs soient unique mais qu'a eux trois il le soient!

Je ne suis pas sur savoir cerné le problème c'est pour cela que je balance des généralités!

Mais il est fort probable que ton problème ne soit pas temps dans ton select que dans la destination.
Par exemple un

Code :

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

insert into table1 select * from table2

peut donner de résultat inattendu alors que

Code :

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

insert into table1(Champs1,Champs2) values(select champs1,champs 2 from table2)

ne laisse aucune ambiguïté!

[marot_r]

Bonjour rdurupt et merci de ta réponse.

Mon problème est plus globale, je veux, du moins j'aimerai beaucoup, lorsque j'ai une erreur 3022 (doublons) dans un formulaire de saisie lié détecter quels sont les indexes uniques concernés.
Quelle que soit le type de source et la façon dont elle est construite.

L'idée de départ était de faire un truc du genre (code bidon, juste pour présenter l'idée) :

Code :

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

1
2
3
4
5
6
7
8
9
dim i as index : for each i in me.recordet.indexes
 
   if i.isUnique then
      'Analyser l'index, 
      'faire une recherche pour avec les données saisie
      'dire à l'utilisateur : La valeurs X, Y et Z dans les champs C1, C2 et C3 sont déjà dans la BD
   end if
 
next i

La partie analyser l'index et le reste, je pense être capable.

C'est trouver les indexes qui me pose un problème car la propriété .Indexes n'existe sur un objet recordset que si c'est un type table.

A+

[Invité]

Normalement c'est une information qui doit ce trouvé dans une des tables système masquées aux utilisateurs, mais dans les option d'Access tu peu les afficher!

[Jean-Philippe André]

Salut,

dans la table MSysRelationships, tu peux trouver la liste des liens

Code :

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

SELECT * FROM MSysRelationships WHERE szObject='MaTable' OR szREferencedObject='MaTable'

a moniter avec un parametre si besoin est + une fonction booleenne par exemple.

[marot_r]

Merci aux contributeurs.

Voici ce que j'ai finalement fait.
Il analyse la source des données (requête enregistrée ou table seulement) et donne la liste de toutes les clefs uniques impliquées.
Cela ne répond pas à mes critères initiaux mais c'est ce que j'ai pu faire de mieux.

Attention nécessite une référence à ADO (sur mon poste : Microsoft ActiveX Data Objects 6.1 Library).
Je me sert de recordset en mémoire pour pouvoir facilement trier et filtrer mes données.

Module de classe : clsInfoClefUnique

Code :

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

1
2
3
4
5
6
7
Option Compare Database
Option Explicit
 
Private m_rListeTable As ADODB.Recordset
Private m_rListeIndex As ADODB.Recordset
Private m_rListeChamp As ADODB.Recordset
Private m_DB As DAO.Database

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
Private Sub Class_Initialize()
    Set m_DB = CurrentDb
 
    Set m_rListeTable = New ADODB.Recordset
 
    With m_rListeTable
        Call .Fields.Append("Nom", adVarChar, 255, adFldMayBeNull)
        Call .Fields.Append("Desc", adVarChar, 255, adFldMayBeNull)
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
    End With
 
    Set m_rListeIndex = New ADODB.Recordset
 
    With m_rListeIndex
        Call .Fields.Append("NomTable", adVarChar, 255, adFldMayBeNull)
        Call .Fields.Append("Nom", adVarChar, 255, adFldMayBeNull)
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
    End With
 
    Set m_rListeChamp = New ADODB.Recordset
 
    With m_rListeChamp
        Call .Fields.Append("NomTable", adVarChar, 255, adFldMayBeNull)
        Call .Fields.Append("NomIndex", adVarChar, 255, adFldMayBeNull)
        Call .Fields.Append("No", adInteger, , adFldMayBeNull)
        Call .Fields.Append("Nom", adVarChar, 255, adFldMayBeNull)
        Call .Fields.Append("Desc", adVarChar, 255, adFldMayBeNull)
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
    End With
 
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub AjouterTable(prmNom As String, prmDesc As Variant)
 
    m_rListeTable.AddNew
 
    With m_rListeTable
        .Fields("Nom") = prmNom
        .Fields("Desc") = prmDesc
    End With
 
    m_rListeTable.Update
End Sub

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 AjouterIndex( _
                prmNomTable As String, _
                prmNom As String)
 
    m_rListeIndex.AddNew
 
    With m_rListeIndex
        .Fields("Nomtable") = prmNomTable
        .Fields("Nom") = prmNom
    End With
 
    m_rListeIndex.Update
End Sub

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
Private Sub AjouterChamp( _
                prmNomTable As String, _
                prmNomIndex As String, _
                prmNo As Long, prmNom As String, prmDesc As Variant)
 
    m_rListeChamp.AddNew
 
    With m_rListeChamp
        .Fields("Nomtable") = prmNomTable
        .Fields("NomIndex") = prmNomIndex
        .Fields("No") = prmNo
        .Fields("Nom") = prmNom
        .Fields("Desc") = prmDesc
    End With
 
    m_rListeChamp.Update
End Sub

Code :

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

1
2
3
4
5
6
Public Sub TrouverInfoClef(prmNomSource As String)
 
    Call InventorierTable(prmNomSource)
    Call InventorierClefUnique
 
End Sub

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Public Property Get InfoClef() As String
    Dim result As String: result = ""
 
    If m_rListeTable.RecordCount <> 0 Then
        m_rListeTable.MoveFirst
        m_rListeTable.Sort = "[Nom]"
 
        '=== Liste les tables
        Do While Not m_rListeTable.EOF
 
            If result <> "" Then
                result = result & vbNewLine
            End If
 
            result = result & "  Dans [" & m_rListeTable.Fields("Nom") & "]"
            result = result & IIf(Not IsNull(m_rListeTable.Fields("Desc")), " (" & m_rListeTable.Fields("Desc") & ")", "")
 
            If m_rListeIndex.RecordCount <> 0 Then
                '=== Liste les indexes
                m_rListeIndex.MoveFirst
                m_rListeIndex.Sort = "[Nomtable], [Nom]"
                m_rListeIndex.Filter = "[NomTable]='" & Replace(m_rListeTable.Fields("Nom"), "'", "''") & "'"
 
                Do While Not m_rListeIndex.EOF
 
                    If result <> "" Then
                        result = result & vbNewLine
                    End If
 
                    result = result & "     Zone(s) de saisie"
 
                    If m_rListeChamp.RecordCount <> 0 Then
                        '=== Liste les champs de l'index
                        m_rListeChamp.MoveFirst
                        m_rListeChamp.Sort = "[Nomtable], [NomIndex], [no]"
                        m_rListeChamp.Filter = "[NomTable]='" & Replace(m_rListeTable.Fields("Nom"), "'", "''") & "'"
                        m_rListeChamp.Filter = m_rListeChamp.Filter & " and [NomIndex]='" & Replace(m_rListeIndex.Fields("Nom"), "'", "''") & "'"
 
                        Do While Not m_rListeChamp.EOF
 
                            If result <> "" Then
                                result = result & vbNewLine
                            End If
 
                            result = result & "       [" & m_rListeChamp.Fields("Nom") & "]"
                            result = result & IIf(Not IsNull(m_rListeChamp.Fields("Desc")), ",  " & m_rListeChamp.Fields("Desc") & "", "")
                            m_rListeChamp.MoveNext
                        Loop
 
                        m_rListeChamp.Filter = ""
                        '--- Liste les champs de l'index
                    End If
 
                    result = result & vbNewLine
                    m_rListeIndex.MoveNext
                Loop
 
                m_rListeIndex.Filter = ""
                '--- Liste les indexes
 
            End If
 
            result = result & vbNewLine
            m_rListeTable.MoveNext
        Loop
        '--- Liste les tables
 
    End If
 
    InfoClef = result
End Property

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
Private Sub InventorierTable(prmSource As String)
    'Detremine les tables qui sont dans la source
    Const NOM_PROC As String = "clsInfoClefUnique.InventorierTable"
 
    Dim SQL As String
 
    If EstTable(prmSource) Then
            Call m_rListeTable.AddNew
 
            With m_rListeTable
                .Fields("Nom") = prmSource
                .Fields("Desc") = LirePropriete(m_DB.TableDefs(prmSource), "Description")
            End With
 
            Call m_rListeTable.Update
 
    ElseIf EstRequete(prmSource) Then
            Dim ClefRequete As Long: ClefRequete = DFirst("Id", "MSysObjects", "[Name]=""" & prmSource & """")
            Dim db As DAO.Database: Set db = CurrentDb
            SQL = "select [MSysQueries].* from [MSysQueries] where"
            SQL = SQL & " [MSysQueries].[ObjectID]=" & ClefRequete
            SQL = SQL & " and [MSysQueries].[Attribute]=5"
 
            Dim r As DAO.Recordset: Set r = db.OpenRecordset(SQL, dbOpenSnapshot)
 
            Do While Not r.EOF
                Call InventorierTable(r![Name1])
                r.MoveNext
            Loop
 
            r.Close: Set r = Nothing
            db.Close: Set db = Nothing
        Else
            Call Err.Raise(5, NOM_PROC, "Impossible d'analyser """ & prmSource & """")
    End If
 
End Sub

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
46
47
48
49
 
Private Sub InventorierClefUnique()
    Dim t As DAO.TableDef
    Dim i As Index
    Dim f As DAO.Field
    Dim cptChamp As Long
 
    If m_rListeTable.RecordCount <> 0 Then
        m_rListeTable.MoveFirst
 
        Do While Not m_rListeTable.EOF
            Set t = m_DB.TableDefs(m_rListeTable.Fields("Nom"))
 
            For Each i In t.Indexes
 
                If i.Unique Then
 
                    Call m_rListeIndex.AddNew
                    m_rListeIndex.Fields("NomTable") = t.Name
                    m_rListeIndex.Fields("Nom") = i.Name
                    Call m_rListeIndex.Update
 
                    cptChamp = 0
 
                    For Each f In i.Fields
                        cptChamp = cptChamp + 1
                        Call m_rListeChamp.AddNew
 
                        With m_rListeChamp
                            .Fields("NomTable") = m_rListeTable.Fields("Nom")
                            .Fields("NomIndex") = m_rListeIndex.Fields("Nom")
                            .Fields("No") = cptChamp
                            .Fields("Nom") = f.Name
                            .Fields("Desc") = LirePropriete(t.Fields(f.Name), "Description")
                        End With
 
                        Call m_rListeChamp.Update
                    Next f
 
                End If
 
            Next i
 
            m_rListeTable.MoveNext
        Loop
 
    End If
 
End Sub

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
Private Function EstTable(prmNom As String) As Boolean
    Dim result As Boolean: result = False
 
    On Error GoTo Err_EstTable
 
    Dim t As DAO.TableDef
    Set t = m_DB.TableDefs(prmNom)
    result = True 'Si on est rendu là c'est que c'est une table
PasUneTable:
    Set t = Nothing
 
Exit_EstTable:
    EstTable = result
    Exit Function
 
Err_EstTable:
    Select Case Err.Number
        Case 3265 'élément non trouvé
            Resume PasUneTable
 
        Case Else
            Call AfficherErreurStandard(Err)
    End Select
 
    Resume Exit_EstTable
 
End Function

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
 
Private Function EstRequete(prmNom As String) As Boolean
    Dim result As Boolean: result = False
 
    On Error GoTo Err_EstRequete
 
    Dim q As DAO.QueryDef
    Set q = m_DB.QueryDefs(prmNom)
    result = True 'Si on est rendu là c'est que c'est une Requete
PasUneRequete:
    Set q = Nothing
 
Exit_EstRequete:
    EstRequete = result
    Exit Function
 
Err_EstRequete:
    Select Case Err.Number
        Case 3265 'élément non trouvé
            Resume PasUneRequete
 
        Case Else
            Call AfficherErreurStandard(Err)
    End Select
 
    Resume Exit_EstRequete
 
End Function

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 Function LirePropriete(prmObjet As Object, prmNomPropriete As String) As Variant
    Dim result As Variant: result = Null
 
    On Error GoTo Err_LirePropriete
 
    result = prmObjet.Properties(prmNomPropriete)
 
PasUnePropiete:
 
Exit_LirePropriete:
    LirePropriete = result
    Exit Function
 
Err_LirePropriete:
    Select Case Err.Number
        Case 438, 3270 'Proprite non supportée
            result = Null
            Resume PasUnePropiete
 
        Case Else
            Call AfficherErreurStandard(Err)
    End Select
 
    Resume Exit_LirePropriete
End Function

Code :

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

1
2
3
4
5
6
7
Private Sub Class_Terminate()
    Call m_rListeChamp.Close: Set m_rListeChamp = Nothing
    Call m_rListeIndex.Close: Set m_rListeIndex = Nothing
    Call m_rListeTable.Close: Set m_rListeTable = Nothing
 
    m_DB.Close: Set m_DB = Nothing
End Sub

Exemple d'utilisation :

À mettre dans un formulaire

Code :

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

1
2
3
Private Sub Form_Error(prmDataErr As Integer, prmResponse As Integer)
    Call mdlErreur.GererOnError(Me, prmDataErr, prmResponse)
End Sub

À mettre dans un module (mdlErreur).

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
Public Sub GererOnError(prmForm As Form, prmDataErr As Integer, prmResponse As Integer)
 
    Select Case prmDataErr
        Case 3399, 3022 'Doublon
            Dim infoClefUnique As New clsInfoClefUnique
            Call infoClefUnique.TrouverInfoClef(prmForm.RecordSource)
            call msgbox(infoClefunique.InfoClef)
            Set infoClefUnique = Nothing
            prmResponse = acDataErrContinue
 
        Case Else
            prmResponse = acDataErrDisplay
    End Select
 
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Sub AfficherErreurStandard(prmErr As ErrObject, Optional prmMess As String = "")
    DoCmd.Hourglass False
    Dim mess As String
 
    If prmMess <> "" Then
        mess = prmMess
        mess = mess & vbNewLine & vbNewLine
    End If
 
    mess = mess & "Erreur : " & prmErr.Number & ", " & prmErr.description
    mess = mess & vbNewLine & vbNewLine & "ATTENTION : Si un traitement était en cours il a sans doute été interrompu et les données affichées pourraient ne pas être correctes."
    MsgBox mess, vbExclamation
End Sub