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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
| Option Compare Database
Option Explicit
Function import()
Dim fd As FileDialog, VPathFic As String
Dim StrSQL1 As String, StrSQL2 As String
Dim NomTbl As String
Dim ssqli As String
On Error GoTo Code_Err
' Créer un objet boite de dialogue d'ouverture de fichier
Set fd = Application.FileDialog(msoFileDialogOpen)
Dim vrtSelectedItem As Variant
' Ouvrir l'objet pour le choix du fichier
With fd
If .Show = -1 Then
VPathFic = .SelectedItems(1)
Else
Exit Function
End If
End With
Set fd = Nothing
' Lier la feuille Excel à la Bdd Access
DoCmd.TransferSpreadsheet acLink, 8, "Feuil_Excel", VPathFic, True, ""
'______________________________________________________________________
'code pour vérifier si la structure de champs de l'import excel correspond à la table access
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef 'Examiner la structure de champs et d'index (index : fonctionnalité qui accélère la recherche et le tri dans une table basée sur des valeurs clés et qui peut garantir l'unicité des lignes d'une table.
Dim fld As DAO.Field 'La clé primaire d'une table est automatiquement indexée. Certains champs ne peuvent pas être indexés en raison du type de données qu'ils contiennent.) d'une table locale, liée ou externe dans une base de données
Dim nomChps As String
Set dbs = CurrentDb 'La méthode CurrentDb renvoie une variable objet de type BaseDonnées qui représente la base de données actuellement ouverte dans la fenêtre Microsoft Access.
For Each tdf In dbs.TableDefs
If tdf.Name = "Feuil_Excel" Then
If tdf.Attributes = 0 Or tdf.Attributes = dbAttachedTable Then
For Each fld In tdf.Fields
nomChps = fld.Name ' représente les champs de la table
Dim i As Integer
Dim message As String
i = i + 1
Select Case i
Case 1
If nomChps <> "CD_NOM" Then message = message & "CD_NOM - "
Case 2
If nomChps <> "LB_NOM" Then message = message & "LB_NOM - "
Case 3
If nomChps <> "LB_AUTEUR" Then message = message & "LB_AUTEUR - "
Case 4
If nomChps <> "NOM_COMPLET" Then message = message & "NOM_COMPLET - "
End Select
Next fld
If message <> "" Then
MsgBox "Vérifier les nom et propriété des champs" & message & " Arrêt de l'import ! recommencez !", vbCritical, "Erreur Importation"
GoTo sortie
End If
End If
Exit For
End If
Next tdf
'_________________________________________________________
' code pour vérifier les doublons sur le champs clé
Dim cpte As Long 'declaration des variables
Dim cpteregr As Long
cpte = DCount("CD_NOM", "Feuil_Excel") ' définissions de la variable dcount qui permet de compter le nombre de cd_nom dans le fichier à importer
Dim db As DAO.Database 'declarer la variable qui fait appel à la référence dao
Dim rst As DAO.Recordset 'declarer la variable qui ouvre un objet Recordset de type dynaset et utilise une instruction SQL pour extraire, filtrer et trier les enregistrements
Dim rst1 As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT Feuil_Excel.CD_NOM FROM Feuil_Excel GROUP BY Feuil_Excel.CD_NOM;") ' rst permet d'obtenir en sql le nombre "distinct" de cd_nom
cpteregr = rst.RecordCount 'Renvoie le nombre d'enregistrements accédés dans un objet Recordset ou le nombre total d'enregistrements dans un objet Recordset de type table ou un objet TableDef. Type Long en lecture seule
Dim diff As Integer
diff = cpte - cpteregr 'pour voir si il y a des doublons, différence entre cpte variable qui compte le cd_nom dans la feuille importer et cpteregr voir audessus
If diff > 0 Then
MsgBox "Il y a " & diff & "doublons sur le CD_NOM !"
Set rst = db.OpenRecordset("SELECT Feuil_Excel.CD_NOM, Count(Feuil_Excel.CD_NOM) AS CompteDeCD_NOM FROM Feuil_Excel GROUP BY Feuil_Excel.CD_NOM HAVING (((Count(Feuil_Excel.CD_NOM))>1));")
rst.MoveFirst 'La méthode Move permet de passer d'un enregistrement à un autre sans appliquer de condition ici le premier (first)
Do While Not rst.EOF ' .eof Renvoie une valeur qui indique si la position d'enregistrement actuelle suit le dernier enregistrement d'un objet Recordset. Type Boolean en lecture seule.
Dim msg As String ' while>> Répète un bloc d'instructions aussi longtemps qu'une condition est vraie (True) ou jusqu'à ce qu'une condition devienne vraie (True
Dim cd As String
cd = rst.Fields("CD_NOM")
msg = msg & vbCr & "- " & cd
rst.MoveNext 'Utilisez la méthode MoveNext pour faire avancer la position de l'enregistrement actif d'un enregistrement (vers la fin de l'objet Recordset
Loop
MsgBox msg & vbCr & "Arrêt de la procédure d'importation"
GoTo sortie
End If
'_______________________________________________________________
' code pour vérifier les doublons sur le champs texte
Set rst = db.OpenRecordset("SELECT Feuil_Excel.LB_NOM FROM Feuil_Excel GROUP BY Feuil_Excel.LB_NOM;")
cpteregr = rst.RecordCount
Set rst = Nothing
Dim lb As String
diff = cpte - cpteregr
If diff > 0 Then
MsgBox "Il y a " & diff & " doublons sur le LB_NOM !"
Set rst = db.OpenRecordset("SELECT Feuil_Excel.LB_NOM, Count(Feuil_Excel.LB_NOM) AS CompteDeLB_NOM FROM Feuil_Excel GROUP BY Feuil_Excel.LB_NOM HAVING (((Count(Feuil_Excel.LB_NOM))>1));")
rst.MoveFirst
Do While Not rst.EOF
lb = rst.Fields("LB_NOM")
Set rst1 = db.OpenRecordset("SELECT Feuil_Excel.LB_NOM, Feuil_Excel.CD_NOM FROM Feuil_Excel Where Feuil_Excel.LB_NOM like " & Chr(34) & lb & Chr(34) & ";")
rst1.MoveFirst
Do While Not rst1.EOF
cd = rst1.Fields("CD_NOM")
msg = msg & vbCr & "- " & cd & " : " & lb
rst1.MoveNext
Loop
rst.MoveNext
Loop
If MsgBox(msg & vbCr & "Cette liste de LB_NOM est en doublons dans la table " & vbCr & "Voulez vous continuer ?", vbYesNo) = vbNo Then GoTo sortie
End If
msg = "" ' permet de reinitialiser la variable message
'_______________________________________________________________
Set rst = db.OpenRecordset("SELECT ESPECES.CD_NOM FROM ESPECES INNER JOIN Feuil_Excel ON ESPECES.CD_NOM = Feuil_Excel.CD_NOM;")
rst.MoveFirst
Do While Not rst.EOF
cd = Nz(rst.Fields("CD_NOM")) ' nz= transforme une valeur null en 0
msg = msg & vbCr & " - " & cd
rst.MoveNext
Loop
If msg <> "" Then
If MsgBox(msg & vbCr & "Cette liste de CD_NOM est déjà présente dans la table, elle ne sera pas intégrée à la base" & vbCr & "Voulez vous continuer ?", vbYesNo) = vbNo Then GoTo sortie
End If
'____________________________________________
' Importer les données
DoCmd.SetWarnings False
StrSQL1 = "INSERT INTO ESPECES ( CD_NOM, LB_NOM, LB_AUTEUR, NOM_COMPLET )" & _
" SELECT Feuil_Excel.CD_NOM, Feuil_Excel.LB_NOM, Feuil_Excel.LB_AUTEUR, Feuil_Excel.NOM_COMPLET" & _
" FROM ESPECES RIGHT JOIN Feuil_Excel ON ESPECES.CD_NOM = Feuil_Excel.CD_NOM" & _
" WHERE (((ESPECES.CD_NOM) Is Null));"
DoCmd.RunSQL StrSQL1
DoCmd.SetWarnings True
MsgBox ("Table ESPECES mise à jour")
'_______________________________________
' Supprimer le feuille liée
DoCmd.DeleteObject acTable, "Feuil_Excel"
Code_Exit:
Exit Function
Code_Err:
MsgBox Error$
Resume Code_Exit
sortie:
Set fld = Nothing
Set tdf = Nothing
Set dbs = Nothing
Set rst = Nothing
Set rst1 = Nothing
Set db = Nothing
DoCmd.DeleteObject acTable, "Feuil_Excel"
Exit Function
End Function |
13/01/2011, 10h47
Comparer les doublons textes
00
