Bonjour Amis codeurs,

Je me retrouve avec un soucis lors de l'exécution de mon code sans vraiment savoir pourquoi...

Depuis longtemps j'utilise un code me permettant de mettre a jour un fichier Excel (base de gestion de stock).
Cette mise a jour de la manière suivante:
Import d'un ZIP (depuis serveur FTP) mis à dispo par l'entreprise où je bosse sur mon poste (C:\TEMP) - OK
Extract d'un fichier TXT contenu dans le ZIP - OK
Import du fichier TXT (avec filtre pour réduire le volume de données dans Excel) - C'est là où ça bug.

Tout se passait correctement jusqu'à il y a un peu.
J'ai vérifié mon code, le fichier TXT, le fichier ZIP, je ne vois aucun changement.
J'ai même été jusqu'à faire une importation manuelle du TXT pour vérifier le bon positionnement des colonnes lors de l'import, aucun changement !

Je sèche complètement.

Je vous poste mon code pour voir si certains sont susceptible de voir ce que je ne vois pas

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
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
 
Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" ( _
    ByVal hInternetSession As Long, ByVal sServerName As String, _
     ByVal nServerPort As Integer, ByVal sUsername As String, _
     ByVal sPassword As String, ByVal lService As Long, _
     ByVal lFlags As Long, ByVal lContext As Long) As Long
Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
     ByVal sAgent As String, ByVal lAccessType As Long, _
     ByVal sProxyName As String, _
     ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias _
     "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, _
     ByVal lpszDirectory As String) As Boolean
Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" ( _
     ByVal hConnect As Long, _
     ByVal lpszRemoteFile As String, _
     ByVal lpszNewFile As String, _
     ByVal fFailIfExists As Long, _
     ByVal dwFlagsAndAttributes As Long, _
     ByVal dwFlags As Long, _
     ByRef dwContext As Long) As Boolean
 
 
 
Public Const FichierSortieVARSITE = "expcom_SPVV.txt"
 
 
Public FicSortie  As String
Public Fichier_Sortie_VARSITE  As String
Public Fichier_Sortie_Unzipped  As String
Public CODEFAMILLE As String
Public ServeurFTP As String
Public NomFile As String
Public RepDL As String
Public FicSortieUnzipped As String
Public NomOnglet As String
 
Sub MAJ()
Dim Fichier_Path As String
'Récuperation des informations spécifiques
RepDL = "C:\TEMP\"
ServeurFTP = "ftp.reflex.inetpsa.com"
NomFile = "RFL_expcom.zip"
FicSortieUnzipped = "expcom.txt"
NomOnglet = "Import_RFL"
CODEFAMILLE = "PDA"
 
Set FeuilleMAIN = Application.ActiveWorkbook.ActiveSheet
 
 
 
Fichier_Sortie_Unzipped = RepDL & FicSortieUnzipped
Fichier_Sortie_VARSITE = RepDL & FichierSortieVARSITE
 
Rep = MsgBox("Voulez-vous récuperer et importer les informations depuis V3NET ?", vbQuestion + vbYesNo + vbApplicationModal + 0, "MAJ Gestion de Stock")
If Rep = 7 Then Exit Sub
 
UserForm_Prog.Label_DownStatus = "In Progress"
UserForm_Prog.Label_DecStatus = "Pending"
UserForm_Prog.Label_MAJStatus = "Pending"
UserForm_Prog.CommandButtonTermine.Enabled = False
UserForm_Prog.Show
 
If Download_fichier = True Then
    UserForm_Prog.Label_DownStatus = "Completed"
    UserForm_Prog.Label_DecStatus = "In Progress"
    UserForm_Prog.Label_MAJStatus = "Pending"
    UserForm_Prog.Repaint
Else
    MsgBox "Une erreur est survenue durant le traitement de récupération du fichier.", vbCritical + vbOKOnly + vbApplicationModal + 0, "MAJ Gestion de Stock"
    End
End If
 
'On verifie si le fichier "expcom.txt" existe.
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
ExistFile = fs.FileExists(Fichier_Sortie_Unzipped)
 
'Si il existe on le supprime avant de dézipper le nouveau
If ExistFile = True Then
    Set FileCible = fs.getfile(Fichier_Sortie_Unzipped)
    FileCible.Delete True
End If
 
'On verifie si le fichier "expcom_SPVV.txt" existe.
 
ExistFile = fs.FileExists(Fichier_Sortie_VARSITE)
 
'Si il existe on le supprime avant de dézipper le nouveau
If ExistFile = True Then
    Set FileCible = fs.getfile(Fichier_Sortie_VARSITE)
    FileCible.Delete True
End If
 
 
 
 
 
If UnZip3(RepDL, FicSortie) = True Then
    UserForm_Prog.Label_DownStatus = "Completed"
    UserForm_Prog.Label_DecStatus = "Completed"
    UserForm_Prog.Label_MAJStatus = "In Progress"
    UserForm_Prog.Repaint
Else
    MsgBox "Une erreur est survenue durant le traitement de décompression du fichier.", vbCritical + vbOKOnly + vbApplicationModal + 0, "MAJ Gestion de Stock"
    End
End If
 
 
'Une fois le ZIP dézippé on le détruit pour ne pas surcharger le repertoire avec tous les ZIP
ExistFile = fs.FileExists(Fichier_Sortie_Unzipped)
 
'Si il existe on le supprime avant de dézipper le nouveau
ExistFile = fs.FileExists(FicSortie)
If ExistFile = True Then
    Set FileCible = fs.getfile(FicSortie)
    FileCible.Delete True
End If
 
UserForm_Prog.Repaint
 
If MAJClasseur2() = True Then
    UserForm_Prog.Label_DownStatus = "Completed"
    UserForm_Prog.Label_DecStatus = "Completed"
    UserForm_Prog.Label_MAJStatus = "Completed"
    UserForm_Prog.Repaint
Else
    MsgBox "Une erreur est survenue durant le traitement de MAJ du classeur.", vbCritical + vbOKOnly + vbApplicationModal + 0, "MAJ Gestion de Stock"
    End
End If
 
 
 
 
UserForm_Prog.CommandButtonTermine.Enabled = True
FeuilleMAIN.Activate
 
End Sub
 
 
Function Download_fichier() As Boolean
 
    Download_fichier = False
    timeStamp = Year(Date) & Month(Date) & Day(Date) & "_" & Hour(Time) & Minute(Time) & Second(Time)
    FicSortie = RepDL & "RFL_expcom" & timeStamp & ".zip"
 
    internet_ok = InternetOpen("", 1, "", "", 0)
    If internet_ok Then
    ftp_ok = InternetConnect(internet_ok, ServeurFTP, 21, "", "", 1, 0, 0)
    ' If FtpSetCurrentDirectory(ftp_ok, "/cours_xl/vba") Then
    succès = FtpGetFile(ftp_ok, NomFile, FicSortie, False, 0, &H0, 0)
    End If
    ' end if
    Download_fichier = succès
 
End Function
 
Function UnZip3(strTargetPath As String, Fname As String)
 On Error Resume Next
    Dim oApp As Object
 
    Dim FileNameFolder As Variant
    Dim Fname2 As Variant
    UnZip3 = False
    Fname2 = Fname
    If Right(strTargetPath, 1) <> Application.PathSeparator Then
 
        strTargetPath = strTargetPath & Application.PathSeparator
 
    End If
 
 
 
    FileNameFolder = strTargetPath
 
 
 
    Set oApp = CreateObject("Shell.Application")
 
    oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname2).items, 24
 
 If Err.Number = 0 Then UnZip3 = True
End Function
 
Sub test()
MAJClasseur2
End Sub
 
Function MAJClasseur2() As Boolean
'Fichier_Sortie_Unzipped = "C:\TEMP\expcom.txt"
 
'Fichier_Sortie_VARSITE = "C:\TEMP\expcom_SPVV.txt"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = Fso.GetFolder(RepDL)
Set fichiers = Dossier.Files
 
 
Set FileCible = Fso.getfile(Fichier_Sortie_Unzipped)
Dim FinalTab
Set FinalTab = CreateObject("Scripting.Dictionary")
 
Set fsodaten = CreateObject("Scripting.FileSystemObject")
Set tscdaten = fsodaten.OpenTextFile(Fichier_Sortie_Unzipped)
line_new_raw_data = tscdaten.ReadLine()
Call FinalTab.Add(0, line_new_raw_data)
line_new_raw_data = tscdaten.ReadLine()
i = 0
Do While line_new_raw_data <> ""
 
 
    line_new_raw_data = Replace(line_new_raw_data, Chr(34), "")
 
 
    Tab_line_new_raw_data = Split(line_new_raw_data, ";")
    If Tab_line_new_raw_data(30) = CODEFAMILLE Then
        If Err.Number = 0 Then
            'On conserve
           i = i + 1
            Call FinalTab.Add(i, line_new_raw_data)
        Else
            ErrorMessageGlobal = ErrorMessageGlobal & Chr(10) & "Ligne du fichier d'entrée KO : " & nbLigneFicEntree
            Err.Clear
        End If
    End If
 
    Rem On passe à la prochaine ligne
    If tscdaten.atEndOfStream = False Then
        line_new_raw_data = tscdaten.ReadLine()
    Else
        line_new_raw_data = ""
    End If
 
    nb_ligne = nb_ligne + 1
 
Loop
tscdaten.Close
 
 
 
 
Set ObjetFile = CreateObject("Scripting.FileSystemObject")
ObjetFile.createtextfile Fichier_Sortie_VARSITE
Set FileOfObject = ObjetFile.getfile(Fichier_Sortie_VARSITE)
Set PointeurInLigneFILE = FileOfObject.openastextstream(8, -2)
 
For j = 0 To i
    PointeurInLigneFILE.writeline FinalTab(j)
Next j
PointeurInLigneFILE.Close
 
 
MAJClasseur
 
If Err.Number = 0 Then MAJClasseur2 = True
 
End Function
 
 
Function MAJClasseur() As Boolean
Dim ClasseurISA As Workbook
Dim FeuilleRFL As Worksheet
 
MAJClasseur = False
On Error Resume Next
 
Application.DisplayAlerts = False
Set ClasseurISA = Application.ActiveWorkbook
Set FeuilleRFL = ClasseurISA.Sheets(NomOnglet)
 
If Err.Number = 9 Then
    Set FeuilleRFL = ClasseurISA.Sheets.Add
    FeuilleRFL.Move After:=Sheets(Sheets.Count)
    FeuilleRFL.Name = NomOnglet
    Err.Clear
End If
 
FeuilleRFL.Cells.ClearContents
FeuilleRFL.Activate
 
With FeuilleRFL.QueryTables.Add(Connection:="TEXT;" & Fichier_Sortie_VARSITE, _
    Destination:=Range("$A$1"))
    .Name = "expcom"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 1252
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = True
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
 
 
FeuilleRFL.Rows("1:1").AutoFilter
 
 
 
MAJClasseur = True
End Function
Lorsque j'exécute mon code je me retrouve avec "Erreur d'exécution '9': L'indice n'appartient pas à la sélection" au niveau de la ligne If Tab_line_new_raw_data(30) = CODEFAMILLE Then.
Si quelqu'un a une idée...