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" |
