Import fichier Excel dans une table Access déjà existante

**icecreams01** · 03/05/2010, 10h20

Bonjour, je travail sur formulaire access qui a terme devra permettre d'importer un fichier Excel choisi (en donnant le chemin) dans une table Access deja existante(elle sera toujours fixe). Pour cela j'ai créé un autre formulaire ou l'utilisateur devra donné le nom des intitulés des champs du fichier excel afin de faciliter la correspondance. Cependant après importation les informations ne sont pas dans les bons champs. J'ai beau chercher l'erreur je suis bloqué.

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
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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
Dim Dbs As DAO.Database
Dim rcs As DAO.Recordset
Dim req As String
Dim sourceImport As Excel.Application
Dim classeurSource As Excel.Workbook
Dim feuilleSource As Excel.Worksheet
Dim champsFeuille() As String
Dim ENTREPRISE As DAO.QueryDef
'Dim interlocuteur As DAO.QueryDef
Dim regExp As New regExp
Dim Arret As Boolean
 
Set Dbs = CurrentDb
 
Set ENTREPRISE = CurrentDb.QueryDefs("importRequete")
'Set interlocuteur = CurrentDb.QueryDefs("ImportInterlocuteur")
 
req = "Select * FROM tbl_PROFIL_IMPORT WHERE nomProfil ='" & Me.lst_nomProfil & "';"
 
Set rcs = Dbs.OpenRecordset(req, dbOpenForwardOnly, dbReadOnly)
 
Set sourceImport = New Excel.Application
sourceImport.Visible = False
Set classeurSource = sourceImport.Workbooks.Open(Me!Chemin.Value)
Set feuilleSource = classeurSource.ActiveSheet
 
i = 0
 
DoCmd.Hourglass True
 
While feuilleSource.Cells(1, i + 1).Value <> ""
 
    i = i + 1
 
Wend
 
ReDim champsFeuille(i)
 
 
While Not rcs.EOF
 
 
For j = 0 To i
 
    champsFeuille(j) = feuilleSource.Cells(1, j + 1).Value
    If champsFeuille(j) = rcs(1) Then
        posNomSoc = j + 1
    End If
 
Next j
 
k = 2
 
j = 0
 
While feuilleSource.Cells(k, 1).Value <> ""
 
    For j = 0 To i
        l = 0
 
        Select Case champsFeuille(j)
 
                Case rcs(1):
                   TITRE = feuilleSource.Cells(k, j + 1).Value
 
                Case rcs(2):
 
                   If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
                       NOM = feuilleSource.Cells(k, j + 1)
                   Else
                       NOM = Null
                   End If
 
               Case rcs(3):
                     If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
 
                          PRENOM = feuilleSource.Cells(k, j + 1)
                    Else
 
                           PRENOM = Null
                    End If
 
              Case rcs(4):
 
                          If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
 
                       DATE_NAISSANCE = feuilleSource.Cells(k, j + 1)
                    Else
                       DATE_NAISSANCE = Null
                    End If
 
               Case rcs(5):
                    If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
                        NO_SIRET = feuilleSource.Cells(k, j + 1)
                    Else
                        NO_SIRET = Null
                    End If
 
 
               Case rcs(6):
                    If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
 
                        NOM_ENTREPRISE = feuilleSource.Cells(k, j + 1)
                    Else
                        NOM_ENTREPRISE = Null
                    End If
 
                Case rcs(7):
 
                    If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
                        ENSEIGNE_ENTREPRISE = feuilleSource.Cells(k, j + 1)
 
                    Else
 
                        ENSEIGNE_ENTREPRISE = Null
                    End If
 
                Case rcs(8):
 
                    If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
                        ADRESSE_ENTREPRISE = feuilleSource.Cells(k, j + 1)
                        ADRESSE_ENTREPRISE = Replace(ADRESSE_ENTREPRISE, " CHE ", " CHEMIN ")
                        ADRESSE_ENTREPRISE = Replace(ADRESSE_ENTREPRISE, " R ", " RUE ")
                        ADRESSE_ENTREPRISE = Replace(ADRESSE_ENTREPRISE, " AV ", " AVENUE ")
                        ADRESSE_ENTREPRISE = Replace(ADRESSE_ENTREPRISE, " IMP ", " IMPASSE ")
                        ADRESSE_ENTREPRISE = Replace(ADRESSE_ENTREPRISE, " ALL ", " ALLEE ")
                        ADRESSE_ENTREPRISE = Replace(ADRESSE_ENTREPRISE, " RTE ", " ROUTE ")
                        ADRESSE_ENTREPRISE = Replace(ADRESSE_ENTREPRISE, " BD ", " BOULEVARD ")
                        ADRESSE_ENTREPRISE = Replace(ADRESSE_ENTREPRISE, " PL ", " PLACE ")
                        ADRESSE_ENTREPRISE = Replace(ADRESSE_ENTREPRISE, " SQ ", " SQUARE ")
 
                    Else
 
                        ADRESSE_ENTREPRISE = Null
                    End If
 
 
                Case rcs(9):
 
                    If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
                        ACTIVITE = feuilleSource.Cells(k, j + 1)
 
                    Else
 
                        ACTIVITE = Null
                    End If
 
                Case rcs(10):
 
                    If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
                        TEL = feuilleSource.Cells(k, j + 1)
 
                    Else
 
                        TEL = Null
                    End If
 
                Case rcs(11):
 
                    If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
                        CP = feuilleSource.Cells(k, j + 1)
 
                        'CPSplit = Split(CP, " ")
                       ' If IsNumeric(CPSplit(0)) Then
                            'CP = CPSplit(0)
                            'CP = Replace(CP, CPSplit(1), "")
 
                        'Else
                            'CPSplit = Split(CP, Chr(160))
                            'If IsNumeric(CPSplit(0)) Then
                               ' CP = CPSplit(0)
                                'CP = Replace(CP, CPSplit(1), "")
                           ' End If
                        'End If
 
                    Else
 
                        CP = Null
 
                    End If
 
                Case rcs(12):
 
                    If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
                        COMMUNE = feuilleSource.Cells(k, j + 1)
 
                    Else
 
                        COMMUNE = Null
                    End If
 
                'Case rcs(13):
                    'If feuilleSource.Cells(k, j + 1) <> "" And feuilleSource.Cells(k, j + 1) <> "-" Then
                       ' DATE_DEBUT_ACTIVITE = feuilleSource.Cells(k, j + 1)
 
                    'Else
 
                        'DATE_DEBUT_ACTIVITE = Null
                    'End If
 
            Case Else
 
 
 
    End Select
 
    Next j
 
ENTREPRISE.Parameters("TITRE") = TITRE
ENTREPRISE.Parameters("NOM RESPONSABLE") = NOM
ENTREPRISE.Parameters("PRENOM RESPONSABLE") = PRENOM
ENTREPRISE.Parameters("NOM ENTREPRISE") = NOM_ENTREPRISE
ENTREPRISE.Parameters("ENSEIGNE ENTREPRISE") = ENSEIGNE_ENTREPRISE
ENTREPRISE.Parameters("ACTIVITE REELLE") = ACTIVITE
'ENTREPRISE.Parameters("ADRESSE ENTREPRISE") = ADRESSE_ENTREPRISE
'ENTREPRISE.Parameters("CODE POSTALE") = CP
ENTREPRISE.Parameters("COMMUNE") = COMMUNE
ENTREPRISE.Parameters("TEL") = TEL
ENTREPRISE.Parameters("FAX") = FAX
ENTREPRISE.Parameters("NUMERO SIREN") = NO_SIRET
 
 
DoCmd.SetWarnings False
ENTREPRISE.Execute
 
DoCmd.SetWarnings True
 
 
j = 0
k = k + 1
Wend
 
Set tbl_Entreprise = Nothing
sourceImport.Quit
Set sourceImport = Nothing
 
rcs.MoveNext
Wend
 
DoCmd.Hourglass False
MsgBox "Import de données terminé sans erreur"

En vous remerciant d'avance pour votre aide éventuelle.

**argyronet** · 04/05/2010, 15h07

Bonjour,

Un

Code :

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

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9...

me paraîtrait aussi (plus) simple que court.

Argy

Import fichier Excel dans une table Access déjà existante

VBA Access

Discussions similaires

Partager

Partager