bonjour,
j'ai conçu une application et ça fait une année que ça marche mais dernièrement le code dégante.
voici le code de l'importation il marche bien:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
chemin = InputBox("Entrer le Chemin relative au fichier Excel 'Collar'", _
"CHEMIN DE LA FEUILLE EXCEL COLLARS")
SourceFile = chemin   ' Définit le nom du fichier source.
DestinationFile = "E:\old.compt\M_GDEx_BOUAZZER\Fichier_Import\CollarEx.xls"    ' Définit le nom du fichier cible.
' Copie le fichier source dans le fichier cible.
FileCopy SourceFile, DestinationFile
'
'importer le fichier Excel vers sql server en se connectant
sql3 = "SELECT * INTO TabCollarEx FROM EXCEL_COLLAR...[feuille1$]"
DoCmd.RunSQL sql3
je fais appelle a ce code lorsque je passe a l'étape suivante de l'importation afin de préciser le code, projet, secteur etc... le problème s’affiche ici, or, lorsque je dépasse l'étape de l'importation je passe à l'étape de la vérification du fichier excel, voici le code:

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
'importation Excel
ImpCollarEx
'DoCmd.Hourglass True
projet:
p = Forms![frmOuverture]!codep
''debug.Print p
' verification de l'ancien id
On Error Resume Next
DoCmd.RunSQL "drop table REPETITION_ANC_ID_COLLAR"
sqlAncIdCol = "select dbo.TabCollarex.anc_id,dbo.TabCollar.Hole_id" & _
" into dbo.REPETITION_ANC_ID_COLLAR" & _
" from dbo.TabCollarex left outer join dbo.TabCollar" & _
" on dbo.TabCollarex.Anc_Id=dbo.TabCollar.Anc_Id collate french_ci_as" & _
" where left(dbo.TabCollar.Hole_Id,2)='" & p & "'"
DoCmd.RunSQL sqlAncIdCol
'
Dim rsVarColEx As ADODB.Recordset
Set rsVarColEx = New ADODB.Recordset
rsVarColEx.Open "[REPETITION_ANC_ID_COLLAR]", con, 1, 3
'
On Error Resume Next
n = rsVarColEx.RecordCount
'
''debug.Print "n"; "__"; n
If n > 0 Then
MsgBox ("Ces collars existent déjà dans le projet." & vbCrLf & _
"Si vous chercher une MAJ de ces mêmes données," & vbCrLf & _
"procéder manuellement ou les supprimer et refaire" & vbCrLf & _
"l'Importation."), vbCritical, _
"COLLARS REPETITIFS"
DoCmd.OpenForm "REPETITION_ANC_ID_COLLAR", acFormDS
GoTo SupTabEx
End If
'vérification de la table importée
DoCmd.RunSQL "drop table ERREUR_COLLARS_EXCEL"
sqlVerCollarsEx = "select tabcollarex.anc_id, tabcollarex.x_collars," & _
" tabcollarex.y_collars" & _
" into ERREUR_COLLARS_EXCEL " & _
" from dbo.tabcollarex" & _
" where " & _
" dbo.Tabcollarex.x_collars is null" & _
" or dbo.Tabcollarex.y_collars is null" & _
" or dbo.Tabcollarex.z_collars is null" & _
" or dbo.Tabcollarex.brg>360" & _
" or dbo.tabcollarex.brg<0" & _
" or dbo.tabcollarex.dip>90 or dbo.Tabcollarex.dip<-90"
DoCmd.RunSQL sqlVerCollarsEx
'
Dim rsTabVer As ADODB.Recordset
Set rsTabVer = New ADODB.Recordset
rsTabVer.Open "[ERREUR_COLLARS_EXCEL]", con, 1, 3


On Error Resume Next
rsTabVer.MoveLast
n = rsTabVer.RecordCount
rsTabVer.MoveFirst
''debug.Print n
'on error goto ErrMessage
If n > 0 Then
MsgBox ("Erreurs dans le fichier Excel importée"), vbCritical, "ERREUR FICHIER"
DoCmd.OpenForm "ERREUR_COLLARS_EXCEL", acFormDS
GoTo SupTabEx
End If
'
'
'On Error Resume Next
'recherche des doublons dans tables excel importées
sqlColEx = "drop table TabDoublonCollarsEx" & _
" select count(*) as doublons,dbo.tabcollarex.anc_id" & _
" into dbo.TabDoublonCollarsEx" & _
" from dbo.TabCollarEx" & _
" group by dbo.TabCollarex.anc_id" & _
" having count(*)>1"
DoCmd.RunSQL sqlColEx
'ouvrir table
'message
'
Dim srTDCEx As ADODB.Recordset
Set srTDCEx = New ADODB.Recordset
srTDCEx.Open "[TabDoublonCollarsEx]", con, 1, 3
'
ndcex = srTDCEx.RecordCount
'
If ndcex >= 1 Then
MsgBox ("La table excel importée contient des doublons." & vbCrLf & _
"A revoir..."), vbCritical, "DOUBLONS DANS TABLE COLLAR IMPORTEE"
'
DoCmd.OpenForm "FrmTabDoublonCollarsEx", acFormDS, , , acFormReadOnly
'DoCmd.Hourglass False
Exit Sub
End If
'
Set rsOuvEx = New ADODB.Recordset
rsOuvEx.Open "[TabCollarEx]", con, 1, 3
'On Error Resume Next
''rsOuvEx.MoveLast
'count = rsOuvEx.RecordCount
'rsOuvEx.MoveFirst

'

alors le fichier excel ne contient aucune erreur mais le code m'affiche le message mentionner dans le code on rouge, et si je saute ce code rouge il m'affiche l'erreur mentionner dans le code on bleu sachant bien que l'excel ne contient pas de doublons.

je ne comprend pas ça bloque dans cette étapes j'ai tout essayé de crée un nouveau serveur lié, de crée un autre fichier excel, j'ai vider le cache mais RIEN.
Je vous demande de bien m'aider par ce que ça fait déjà un mois que je bloque sur ce problème.
Salutations.