Gestion des doublons dans l'import de fichier excel dans access

**Nitromard** · 27/04/2011, 09h27

Bonjour à tous,

J'ai un problème de doublons lorsque j'extrais des données d'excel vers access. Le programme m'affiche l'erreur :

The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship. Chqnge the data in the field or fields that contain duplicate data, remove the index, or redefine the index to permit duplicate entries and try again.

En fait j'ai dans ma table 2 clés primaires, mais lorsque j'ai un doublon que j'essaye d'importer, le programme me met cette erreur et ne continue pas sur les autres fichiers excel.
(pour moi un doublon est une ligne qui a les mm 2 clés primaires qu'une qui est déjà dans la table)
J'aimerais pouvoir éviter d'afficher cette erreur à chaque fois qu'il y a un doublon et ainsi continuer le programme, tout en évitant de me mettre le doublon dans la table.

Voici mon programme :

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
Sub tranfertFeuilleClasseursFermes_VersAccess()
Dim Cn As New ADODB.Connection
Dim oProdRS As New ADODB.Recordset, oRS As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim j As Integer
Dim Fichier As String, Repertoire As String
 
'------------------------------------------------------
'Connection à la Base Access
Set oConn = CurrentProject.Connection

'les données seront placés dans Table1
Set oRS = New ADODB.Recordset
oRS.Open "Select * from Table1", oConn, adOpenKeyset, adLockOptimistic
'------------------------------------------------------
 
'Boucle sur les classeurs Excel du répertoire cible
Repertoire = "C:\Users\qdeutschle\Desktop\Work\Données\Folder"
Fichier = Dir(Repertoire & "\*.xls")

Do While Fichier <> ""
    'Connection au classeur Excel
    Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & "\" & Fichier & ";" & _
    "Extended Properties=""Excel 8.0;"""
    
    'requête pour extraire les données de la Feuil1
    oProdRS.Open "SELECT * FROM [Sheet4$]", Cn, adOpenStatic
    
    ' --- Transfert des données dans la base ---
    Do While Not (oProdRS.EOF)
        oRS.AddNew
            For j = 0 To oRS.Fields.Count - 1
            oRS.Fields(j) = oProdRS.Fields(j).Value
            Next j
        oRS.Update       
oProdRS.MoveNext
    Loop
    '-------------------------------------------
    
    oProdRS.Close
    'Fermeture de la connection au classeur Excel
    Cn.Close
Fichier = Dir
Loop

oRS.Close
Set oRS = Nothing
'Fermeture de la connection Access
oConn.Close
Set oConn = Nothing
End Sub

(j'ai mis en rouge ce que le débugger me surligne lorsqu'il m'affiche l'erreur)

Merci d'avance pour votre aide.

**Jean-Philippe André** · 27/04/2011, 10h28

salut,

ne serait-ce pas plus simple de faire un import complet du fichier excel, puis d'executer une requete au lieu de faire du ligne a ligne dans ton cas ?

**Nitromard** · 27/04/2011, 10h35

Non je ne pense pas, j'ai juste donné un programme simplifié de celui avec lequel je vais travailler, car en fait je dois aussi et surtout importer des données de feuilles excel vers des tables déjà existante et actualiser ces tables, et en créer de nouvelles lorsque elle n'existe pas pour le nom du fichier.

Pour le moment mon seul problème c'est les doublons...
J'avais essayé avec On Error Goto, mais je ne savais pas trop où le mettre et j'avais quand même des erreurs de doublons.

J'ai aussi essayé avec On Error Resume Next, le problème est qu'il me met quand même les doublons dans les tables.

**Nitromard** · 29/04/2011, 11h49

Je n'ai toujours pas d'idée d mon côté pour éviter les doublons, quelqu'un aurait une idée?
Existerait-il une fonction qui permette de sauter une action dans le code lorsqu'il y a un message d'erreur?
Le problème avec On error goto c'est que j'ai une erreur à la base sur :

Code :

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

oRS.Update

Et quand je le met autour de cette ligne pour passer à la valeur suivante de ma feuille excel à extraire, il me met l'erreur de doublons sur le :

Code :

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

oRS.AddNew

Et là je reste bloqué...

**User** · 29/04/2011, 17h50

Salut,

Peut-être en testant si la clé est présente dans la table destination:

En supposant que ta clé est composée des 2 premiers champs numériques: "Champ1" et "Champ2"

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
 
Do While Not (oProdRS.EOF)
 
       if IsNull(DLookUp("Champ1",TableName,"Champ1=" & oProdRS.Fields(0).Value & " and Champ2=" & oProdRS.Fields(1).Value)) then
 
          oRS.AddNew                 
 
          For j = 0 To oRS.Fields.Count - 1
              oRS.Fields(j) = oProdRS.Fields(j).Value
          Next j
 
          oRS.Update
 
       end if 
 
 oProdRS.MoveNext
 Loop

A+

**Godzestla** · 02/05/2011, 08h49

Bonjour,

je pense comme Jpcheck.

Il est nettement plus simple et plus fiable d'importer complètement le fichier excel vers une table de travail puis via une requete tester pour chaque record si il a doublon ou pas avant de l'utiliser pour mettre à jour la véritable access.

**Nitromard** · 02/05/2011, 11h38

Bonjour,

User, j'ai tenté ta méthode :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Do While Not (oProdRS.EOF)
            If IsNull(DLookup("Numero", TableName, "Numero=" & oProdRS.Fields(0).Value & " and Date_Nav=" & Format(oProdRS.Fields(1), "dd/mm/yyyy"))) Then
 
                oRS.AddNew
                For j = 0 To oRS.Fields.Count - 1
                    oRS.Fields(j) = oProdRS.Fields(j).Value
                Next j
                oRS.Update
            End If
                oProdRS.MoveNext
            Loop

(Juste une précision, le programme que je vous ai montré n'est pas le programme que j'utilise mais c'est la base de mon programme, je vous met le programme complet si cela vous intéresse)

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
Function ExtractExcel()
 
Dim Cn As New ADODB.Connection
Dim oProdRS As New ADODB.Recordset, oRS As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim j As Integer
Dim Fichier As String, Repertoire As String
Dim Tbl As TableDef
Dim Fich As String
Dim TableExiste As Boolean
Dim TableName As String
Dim RepDest As String
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.Folder
 
'Instanciation du FSO
Set oFSO = New Scripting.FileSystemObject
 
'On vérifie si le répertoire de destination n'existe pas déjà
If Dir("C:\Users\qdeutschle\Desktop\Demo" & "\" & Format(Now, "dd-mmm-yyyy"), vbDirectory) = "" Then
    'Crée le repertoire
    Set oFld = oFSO.CreateFolder("C:\Users\qdeutschle\Desktop\Demo" & "\" & Format(Now, "dd-mmm-yyyy"))
    RepDest = "C:\Users\qdeutschle\Desktop\Demo" & "\" & Format(Now, "dd-mmm-yyyy")
Else
    RepDest = "C:\Users\qdeutschle\Desktop\Demo" & "\" & Format(Now, "dd-mmm-yyyy")
End If
 
'Boucle sur les classeurs Excel du répertoire cible
Repertoire = "C:\Users\qdeutschle\Desktop\Demo\Test"
Fichier = Dir(Repertoire & "\*.xls")
 
'Connection à la Base Access
Set oConn = CurrentProject.Connection
Set oRS = New ADODB.Recordset
 
'S'il y a une erreur, on la passe, mais l'action se fait quand même
On Error Resume Next
 
 
Do While Fichier <> ""
    'Connection au classeur Excel
    Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & "\" & Fichier & ";" & _
    "Extended Properties=""Excel 8.0;"""
 
    TableExiste = False
 
    'Parcours du nom des tables de la base pour le fichier
    For Each Tbl In CurrentDb.TableDefs
        Fich = Left(Fichier, Len(Fichier) - 4)
        TableName = Tbl.Name
 
        If Fich = TableName Then
            TableExiste = True
            'requête pour extraire les données de la Feuil1
            oProdRS.Open "SELECT * FROM [PortFolio$]", Cn, adOpenStatic
            oRS.Open "Select * from " & TableName & "", oConn, adOpenKeyset, adLockOptimistic
 
            ' --- Transfert des données dans la base ---
            Do While Not (oProdRS.EOF)
            If IsNull(DLookup("Numero", TableName, "Numero=" & oProdRS.Fields(0).Value & " and Date_Nav=" & Format(oProdRS.Fields(1), "dd/mm/yyyy"))) Then
 
                oRS.AddNew
                For j = 0 To oRS.Fields.Count - 1
                    oRS.Fields(j) = oProdRS.Fields(j).Value
                Next j
                oRS.Update
            End If
                oProdRS.MoveNext
            Loop
        oProdRS.Close
        oRS.Close
 
        ElseIf Left(Fichier, 3) = "NAV" Then
            TableExiste = True
            'requête pour extraire les données de la Feuil1
            oProdRS.Open "SELECT * FROM [NAV$]", Cn, adOpenStatic
            oRS.Open "Select * from  HISTO_FUND ", oConn, adOpenKeyset, adLockOptimistic
 
            ' --- Transfert des données dans la base ---
            Do While Not (oProdRS.EOF)
                oRS.AddNew
                    For j = 0 To oRS.Fields.Count - 1
                    oRS.Fields(j) = oProdRS.Fields(j).Value
                    Next j
                oRS.Update
                oProdRS.MoveNext
            Loop
        oProdRS.Close
        oRS.Close
        End If
    Next Tbl
 
    'Si pas de table du nom du fichier, créer une table
    If TableExiste = False Then
        CurrentDb.Execute "SELECT * INTO [" & Fich & "] FROM TableSource"
        CurrentDb.Execute "CREATE INDEX NewIndex ON " & Fich & "(Numero, Date_Nav) WITH PRIMARY"
 
        'requête pour extraire les données de la Feuil1
        oProdRS.Open "SELECT * FROM [PortFolio$]", Cn, adOpenStatic
        oRS.Open "Select * from " & Fich & "", oConn, adOpenKeyset, adLockOptimistic
 
        ' --- Transfert des données dans la base ---
        Do While Not (oProdRS.EOF)
            oRS.AddNew
            For j = 0 To oRS.Fields.Count - 1
                oRS.Fields(j) = oProdRS.Fields(j).Value
            Next j
            oRS.Update
            oProdRS.MoveNext
        Loop
        oProdRS.Close
        oRS.Close
    End If
 
    'Fermeture de la connection au classeur Excel
    Cn.Close
    'Déplacer le fichier dans le folder date du jour
    'Si fichier existe déja :
    oFSO.MoveFile Repertoire & "\" & Fichier, RepDest & "\" & Fichier
Fichier = Dir
 
Loop
 
On Error GoTo 0
 
oConn.Close
Set oRS = Nothing
'Fermeture de la connection Access
Set oConn = Nothing
 
End Function

J'ai fait le test avec une table dans laquelle j'ai mis des données et j'ai essayé d'y ajouter des valeurs déja existante et il entre quand mm dans la boucle...et donc me crée la mm erreur qu'au début...(sauf si bien sûr je met le on error resume next)

J'ai alors fait plusieurs autres tests, du genre juste changer la date et ça fonctionne bien, et il ne me crée plus de doublons (il m'avait mis les données de la table 6112 dans la table 0053 mais il ne me le fait plus).

Donc pour l'instant ça à l'air de fonctionner, je vais faire d'autres tests et je vous tiens au courant.

**Nitromard** · 02/05/2011, 12h02

Bon j'ai refait des tests, et il y a effectivement un problème...
Alors je vous explique mon programme :
Il prend un fichier xls d'un dossier, regarde s'il existe une table qui porte le mm nom, si c'est le cas, il importe les données sinon il regarde si le mot NAV apparait dans le nom du fichier excel et importe les données dans la table corespondante sinon, il crée une nouvelle table à partir d'une table source qui a la mm structure et importe les données.

J'ai fait un test avec 2 fichiers excel différents 6112.xls et 5030.xls, les 2 portent les numéros 1 à 640 en 1ère clé primaire, par contre l'un porte les dates 30/12/2010 en 2nde clé primaire et l'autre les dates 01/01/2005.(il y a donc répétition 640 fois de ces dates)
Je les importe une fois en table, aucun problème tout va bien.
Ensuite je refais le test avec les mm fichiers excel sans rien y modifier et le problème est que :
Il met les données du fichier excel 6112 dans la table 5030... Du coup il n'y a effectivement pas de doublons mais il s'est trompé de table.
J'ai utilisé le débugger pour voir les étapes du programme et en fait il fait tout comme il faut, il trouve bien la bonne table 6112 pour le bon fichier excel 6112 et idem pour 5030, mais il importe quand mm les données de 6112 mais dans la table 5030...

Voila pour résumer ^^. Y aurait-il un problème quelque part ?

(Je pense que ça vient du faire qu'il lise quand mm les données et du coup il faut bien qu'il les enregistre quelque part, alors il les met dans une autre table que celle prévue...mais comment modifier cela?)

(en fait j'ai dû faire une faute dans ma condition if, parce qu'apparemment la valeur de isnull(dlookup(...)) est toujours true. Donc il ne trouve jamais la condition que je lui donne)

**Godzestla** · 02/05/2011, 14h27

Rebonjour,

J'ai utilisé le débugger pour voir les étapes du programme et en fait il fait tout comme il faut, il trouve bien la bonne table 6112 pour le bon fichier excel 6112 et idem pour 5030, mais il importe quand mm les données de 6112 mais dans la table 5030...

Tu dois pouvoir mettre le doigt la dessus via le debugger.

C'est vraisemblablement un problème de logique de programmation (IF Then Else mal positionné), un variable mal réinitialisée ou qqchose du genre.

Bon debug.

Gestion des doublons dans l'import de fichier excel dans access

VBA Access

Vue hybride

Discussions similaires

Partager

Partager