gestion erreur 3022

Question

Bonjour,

J'essaie d'enregistrer des valeurs d'une feuille Excel Vers une table Access et j'ai une "Erreur d'exécution « 3022 »: les modifications que vous avez demandé à la table n'ont pas réussies car ils vont créer des valeurs en double dans l'index, la clé primaire ou la relation" qui bloque cette opération. Cette erreur apparait sur .update

Quelqu'un pourrait m'expliquer comment gérér cette erreur et permettre l'enregistrement de mes valeurs. Merci par avance.

Voici mon programme

Private Sub EBase_Entree()

'*************************************************************************************************'
'** Ce programme permet de copier les données d'une feuille de calcul Excel vers une table Access.
'** Définition des éléments utilisés :
'** Nom de la base de données :                             -->    Pilotage_DR.mdb
'** Table recevant les données Excel :                      -->    Ref_GPAE
'** Feuille de calcul Excel d'où l'on exporte les données : -->    SDataBase
'*************************************************************************************************'

Dim Plage As Range
Dim Array1 As Variant
Dim x As Variant
Dim db1 As Database
Dim Rs1 As Recordset

'** Ouverture de la base de données
'    Set Db1 = DBEngine.OpenDatabase(ThisWorkbook.Path & "\Commandes.mdb")
    Set db1 = DBEngine.OpenDatabase(ThisWorkbook.Path & "\Pilotage_DR.mdb")

'** Ouverture de la table Ref_GPAE
'** Un objet Recordset représente les enregistrements d'une table
'     Set Rs1 = Db1.OpenRecordset("Factures", dbOpenDynaset)
     Set Rs1 = db1.OpenRecordset("Ref_GPAE", dbOpenDynaset)

'** Détermination de la taille de la plage à envoyer vers Access
    Set Plage = Worksheets("SDataBase").Range("A1").CurrentRegion.Offset(1, 0)
    Set Plage = Plage.Resize(Plage.Rows.Count - 1, Plage.Columns.Count)
    Plage.Select

'** Lecture de la plage pour renvoyer une valeur contenant un tableau
    Array1 = Plage.Value

'On Error Resume Next
'** Ecriture des données depuis Excel vers les enregistrement de la table Factures
    For x = 1 To UBound(Array1, 1)
        With Rs1
            .AddNew
            .Fields("Code_Site") = Array1(x, 1)
            .Fields("Code_Dispositif") = Array1(x, 2)
            .Fields("Libelle_Dispositif") = Array1(x, 3)
            .Fields("Code_Regroupement") = Array1(x, 4)
            .Fields("Id_Onglet_Excel") = Array1(x, 5)
            .Fields("Ratio_GPAE_An") = Array1(x, 6)
            .Fields("Unite_Oeuvre") = Array1(x, 7)
            .Fields("Ratio_GPAE_Jour") = Array1(x, 8)
            .Fields("Duree_UO_Mn") = Array1(x, 9)
            .Update ' L'erreur 3022 apparait ici
        End With
    Next
'On Error GoTo 0
'** Fermeture de la Base de données
    db1.Close

'** Effacement des données copiées vers la base (sauf les titres)
'    With Selection.CurrentRegion
'        Intersect(.Cells, .Offset(1)).Select
'    End With
'
'    Selection.ClearContents
     
'** Libération des variables
    Set Rs1 = Nothing
    Set db1 = Nothing

End Sub

et mes valeurs

Code_Site Code_Dispositif Libelle_Dispositif Code_Regroupement Id_Onglet_Excel Ratio_GPAE_An Unite_Oeuvre Ratio_GPAE_Jour Duree_UO_Mn
50 RS1 Dossier rémunération prise en charge FP FP 4000 20 24
50 RS9 Dossier rémunération états de présence FP FP 26667 129 3,599999905
50 P2S Dossiers protection sociale FP FP 5900 29 16,29999924
50 EQ6M Enquête à 6 mois FP FP 32000 150 3
50 MESD Dossiers de Mesure FP FP 10000 210 6

Utilisateur anonyme · Answer

Bonjour,

Utilise les balises (3eme icone depuis la droite) de coloration de code, donne la ligne en défaut, un exemple du résultat souhaité. Merci.

cs_Jack · Answer

Salut

Ton message d'erreur parle d'index et de clé primaire.
Dans ta table Ref_GPAE, quels sont ces index et clé primaire ?
Quel champ est-il lié par relation avec une autre table ?

Dans cette même table, y a t-il des champs définis comme Auto-Incrément ?

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

nastydog · Answer

Bonjour et merci de me consacrer du temps,

Dans la table il n'y a aucun champ définis comme Auto-Incrément.

En supprimant les clés primaires sur les champs "Code_Site"  et "Code_Dispositif" de la table "Ref_GPAE" qui sont liées à une autre table, l'erreur ne se produit plus.

[b]Par contre , lorsque j'enregistre , j'ai des enregistrements doublons.
Je voudrais éviter ce problème.
/b

Je viens de mettre en place, une solution qui ne me satisfait pas, pour éviter les doublons, car je voudrais garder la structure mise en place dans la BDD. J'exporte mes données sur une feuille Excel, je supprime ces données de ma table. L'utilisateur effectue ou pas des modifications sur ces dernières et, lors de la fermeture de la feuille je ré enregistre ces données dans ma table.

je viens de trouver sur le site : http://officesystemaccess.seneque.net/vba/codesdao.htm une définition plus précise du code d'erreur 3022

3022 Modifications non effectuées: risque de doublons dans champs index, clé principale ou relation interdisant les doublons. Modifiez les données des champs contenant les doublons, enlevez ou redéfinissez l'index pour permettre les doublons et recommencez.

cs_Jack · Answer

Pourquoi veux-tu supprimer des clés primaires ?
Elles sont justement là comme garde-fou pour éviter de stocker 2 infos identiques.

Tu tentes d'ajouter des données en utilisant un "Code_Site" ou un "Code_Dispositif" identique à une donnée existante.
Si tel est le cas, il faudrait faire une mise à jour de la fiche existante et pas un ajout.
Il faut donc faire un .Find dans ton RecordSet et, si tu trouves un enregistrement, ne pas faire de AddNew mais seulement un .Update après avoir modifiées les données.

"Code_Site" et "Code_Dispositif" sont des clés primaires d'une même table ?
Si tel est le cas, tu vas avoir un problème avec DAO = le type des objets que tu utilises avec tes déclarations standards :
Dim db1 As Database
Dim Rs1 As RecordsetEn effet, DAO est obsolète et notamment sa méthode .Find ne fonctionne pas si tu fais une recherche de plusieurs champs.
Utilises ADODB à la place - presque même syntaxe.
Ajoute la référence suivante à ton projet :
"Microsoft ActiveX Data Objects X.Y Library"
où X.Y devrait être 2.8 (ou 6.1 mais pas sûr)
puis déclare tes objets :
Dim db1 As ADODB.Connection
Dim Rs1 As ADODB.RecordsetTa méthode de connexion sera surement à revoir aussi.

cs_Jack · Answer

Connexions en tout genre : <site de référence>

nastydog · Answer

Merci Jack 
Je vais tester et je te tiens au courant des suites...

nastydog · Answer

bonjour Jack,

Je viens de reprendre mon code, je te le joins ci dessous

Function ExportBase()

Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long

    chemin = ActiveWorkbook.Path
    Source = chemin & "\Pilotage_DR.mdb"
    
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= " & Source & ";"

    Set rs = New ADODB.Recordset
    rs.Open "[Ref_GPAE]", cn, adOpenKeyset, adLockOptimistic, adCmdTable '** Tous les enregistrements de la table.

'** Détermination de la taille de la plage à envoyer vers Access
    Set Plage = Worksheets("SDataBase").Range("A1").CurrentRegion.Offset(1, 0)
    Set Plage = Plage.Resize(Plage.Rows.Count - 1, Plage.Columns.Count)
    Plage.Select

'** Lecture de la plage pour renvoyer une valeur contenant un tableau
    Array1 = Plage.Value
    
    For x = 1 To UBound(Array1, 1)
        With rs

'.Find "[Code_Site] = """ & Array1(x, 1) & """ And [Code_Dispositif] = """ & Array1(x, 2) & """", , adSearchForward
'.Find "[Code_Site] = """ & Array1(x, 1) & """", , adSearchForward
.Filter "[Code_Site] """ & Array1(x, 1) & """ And [Code_Dispositif]= """ & Array1(x, 2) & """"
            
            If .EOF Then
                .AddNew
                .Fields("Code_Site") = Array1(x, 1)
                .Fields("Code_Dispositif") = Array1(x, 2)
            End If
                
            .Fields("Libelle_Dispositif") = Array1(x, 3)
            .Fields("Code_Regroupement") = Array1(x, 4)
            .Fields("Id_Onglet_Excel") = Array1(x, 5)
            .Fields("Ratio_GPAE_An") = Array1(x, 6)
            .Fields("Unite_Oeuvre") = Array1(x, 7)
            .Fields("Ratio_GPAE_Jour") = Array1(x, 8)
            .Fields("Duree_UO_Mn") = Array1(x, 9)
            .Update
        End With
    Next
    
    '** Effacement des données copiées vers la base (sauf les titres)
    With Selection.CurrentRegion
        Intersect(.Cells, .Offset(1)).Select
    End With

    Selection.ClearContents
    
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
End function

J'ai essayé avec Find 
1er essai était avec opérateur AND mais il ne gère pas les opé AND et OR
2 essai sans l'opérateur et avec une seule condition apparemment le problème se situe au niveau de cette boucle, la valeur est tjrs égale à True

            
If .EOF Then
.AddNew
.Fields("Code_Site") = Array1(x, 1)
.Fields("Code_Dispositif") = Array1(x, 2)
End If

le meme probleme avec l'option filter

En l'occurrence si il n'existe aucun enregistrement cela passe
mais si il y a des doublons , j'ai une erreur d'exécution de type "-21477887 (80040e21)' il s'agit toujours d'un problème de doublons.

Merci pour ton aide, je continue à chercher.

Gestion erreur 3022

7 réponses

Votre réponse

Discussions similaires