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
| Public Function BotIE_BA(ByRef IE As InternetExplorer, ByVal DateBA As String, ByVal PR As String, ByVal Log As String, ByVal Pass As String) As String
''''''''''''''''''''''''''''''''''''''
'Fonction de recherche Base Assistance
''''''''''''''''''''''''''''''''''''''
NbErr = 0
NbErr2 = 0
'Récupération de la liste des trains de la feuille "Général" dans un tableau "virtuel"
'que l'on appelle "TabMarche", qui va nous servir de tampon pendant la recherche
With ThisWorkbook.Worksheets("Général")
ListMatos = .Range("A6").End(xlDown).Row - 6
ReDim TabMarche(ListMatos, 2)
For J = 0 To ListMatos
TabMarche(J, 0) = .Range("A" & J + 6).Value
Next J
End With
IE.navigate "https://www.int.sncf.fr"
''WaitIE IE
'Lancement de la navigation dans Base Assistance
IE.navigate "http://base-assistance.sncf.fr/"
'IE.Visible = False
IE.Visible = True
'on attend que IE charge la page en entier
WaitIE IE
Set IEDoc = IE.document
'Bloc de login Base Assistance, permetant de verifier si on est déja connecté
IEDoc.parentWindow.Location.href = "/commun/html/prive/commun/cadrePrincipal.html?time="
Application.Wait DateAdd("s", 2, Now)
If Not IE.LocationURL = "http://base-assistance.sncf.fr/commun/html/prive/commun/cadrePrincipal.html?time=." Then
If Not IE.LocationURL = "http://base-assistance.sncf.fr/commun/html/prive/commun/cadrePrincipal.html?time=" Then
'Si ce n'est pas le cas on se connecte avec les éléments renseignés dans la feuille "Général"
Set InputZoneText = IEDoc.all("j_username")
InputZoneText.Value = Log
Set InputZoneText = IEDoc.all("j_password")
InputZoneText.Value = Pass
Set InputButton = IEDoc.all("btn_valider")
InputButton.Click
End If
End If
WaitIE IE
Sleep 2000
'Boucle d'attente item 19 "http://base-assistance.sncf.fr/commun/html/prive/navigation/navigationBar.html"
Do Until Not IEDoc.all.Item(18) Is Nothing
DoEvents
Loop
[B]Set IEDoc2 = IEDoc.all.Item(18)
Do Until Not IEDoc2.all("ratMenu4_8") Is Nothing
DoEvents
Loop
'Click sur le bouton "Flux voyageurs" du menu "Occupation"
Set InputZoneText = IEDoc2.all("ratMenu4_8")
InputZoneText.Children.Item(0).Click
IE.document.all("ratMenu4_8")
WaitIE IE
'Pause en ms
Sleep 500
''''''''''''''''''''''''''''
'Base assistance est architecturé en plusieurs "Framesets" qui contiennent des "frames"
'en raison de l'utilisation de ce type d'architecture il est nécessaire de rajouter le site
'de base assistance aux sites de confiance dans les paramètres internet du système,
'sinon les frames les plus profondes ne pourront pas être utilisées
''''''''''''''''''''''''''''
'On charge une variable avec la frame qui nous intéresse
On Error GoTo ErrorHandler
Do Until Not IEDoc.frames(2).frames(0).document Is Nothing
DoEvents
Loop
On Error GoTo 0
Set IEDoc2 = IEDoc.frames(2).frames(0).document
'On démarre la boucle de recherche des trains
ValMax = UBound(TabMarche)
For K = 0 To UBound(TabMarche)
'Bloc de test du bouton annuler
If WaitBox.Annuler.Cancel = True Then
Call Annulation(IE)
Exit Function
End If
'Init variables
FoundD = False
FoundO = False
'MAJ WaitBox
WaitBox.ProgressBar1.Max = ValMax + 1
WaitBox.ProgressBar1.Value = K + 1
WaitBox.ProgressBar1.Refresh
WaitBox.Repaint
'Attente IE
'WaitIE IE
On Error GoTo ErrorHandler
'On renseigne de la date
Set InputZoneText = IEDoc2.all("txtDate")
InputZoneText.Value = DateBA
'On remplie le champ train
Set InputZoneText = IEDoc2.all("txtNumero")
InputZoneText.Value = TabMarche(K, 0)
On Error GoTo 0
'On cherche dans la liste des gares notre PR et on récupère son index
Set InputList = IEDoc2.all("cbGare")
For Y = 0 To InputList.Options.all.Length - 1
If InputList.Options.all(Y).innerText = PR Then
'On selectionne le PR avec l'index
InputList.Value = InputList.Options.all(Y).Value
Exit For
End If
Next
'Click du bouton
On Error GoTo ErrorHandler
Set InputButton = IEDoc2.getElementsByTagName("INPUT")(8)
InputButton.Click
On Error GoTo 0
'WaitIE IE
'Attente du chargement de la frame
Do Until Not IEDoc.frames(2).frames(1).document Is Nothing
DoEvents
Loop
'Pause en ms
Sleep 100
On Error GoTo ErrorHandler
Do Until IEDoc.frames(2).frames(1).document.readyState = "complete"
'MAJ Waitbox
WaitBox.Etat2.Caption = "Attente d'Internet Explorer"
WaitBox.Repaint
DoEvents
Loop
On Error GoTo 0
'MAJ WaitBox
WaitBox.Etat2.Caption = "Traitement en cours"
WaitBox.Repaint
'Init de la variable de présence train
Set PresTrain = IEDoc.frames(2).frames(1).document.getElementsByTagName("TR")
If PresTrain.Length <> 0 Then
'On verifie si le train recherché à été trouvé
If InStr(1, PresTrain.Item(3).all(0).innerText, TabMarche(K, 0), vbTextCompare) <> 0 Then
'Init des variables des gares origine et destination
GareOBA = IEDoc2.getElementsByTagName("INPUT")(2).Value
GareDBA = IEDoc2.getElementsByTagName("INPUT")(6).Value
'Bloc de selection de la gare, on effectue une recherche pour l'origine et la destination
For Y = 0 To InputList.Options.all.Length - 1
'Si la gare origine est trouvée on continue ici
If InputList.Options.all(Y).innerText = GareOBA And FoundO = False Then
InputList.Value = InputList.Options.all(Y).Value
'Click sur le bouton de recherche
InputButton.Click
'Attente de chargement de la frame
Do Until Not IEDoc.frames(2).frames(1).document Is Nothing
DoEvents
Loop
'Pause en ms
Sleep 100
On Error GoTo ErrorHandler
Do Until IEDoc.frames(2).frames(1).document.readyState = "complete"
'MAJ WaitBox
WaitBox.Etat2.Caption = "Attente d'Internet Explorer"
WaitBox.Repaint
DoEvents
Loop
On Error GoTo 0
'MAJ WaitBox
WaitBox.Etat2.Caption = "Traitement en cours"
WaitBox.Repaint
'On inscrit dans notre tableau "TabMarche" la valeur du nombre de personnes montant à l'origine
TabMarche(K, 1) = IEDoc.frames(2).frames(1).document.getElementsByTagName("TR").Item(3).all(3).innerText
'On memorise le resultat de la recherche de la gare origine
FoundO = True
End If
'Si la gare destination est trouvée on continue ici
If InputList.Options.all(Y).innerText = GareDBA And FoundD = False Then
InputList.Value = InputList.Options.all(Y).Value
'Click sur le bouton de recherche
InputButton.Click
'Attente de chargement de la frame
Do Until Not IEDoc.frames(2).frames(1).document Is Nothing
DoEvents
Loop
'Pause en ms
Sleep 100
On Error GoTo ErrorHandler
Do Until IEDoc.frames(2).frames(1).document.readyState = "complete"
'MAJ WaitBox
WaitBox.Etat2.Caption = "Attente d'Internet Explorer"
WaitBox.Repaint
DoEvents
Loop
On Error GoTo 0
'MAJ WaitBox
WaitBox.Etat2.Caption = "Traitement en cours"
WaitBox.Repaint
On Error GoTo ErrorHandler
'On inscrit dans notre tableau "TabMarche" la valeur du nombre de personnes descendant à la destination
TabMarche(K, 2) = IEDoc.frames(2).frames(1).document.getElementsByTagName("TR").Item(3).all(1).innerText
On Error GoTo 0
'On memorise le resultat de la recherche de la gare destination
FoundD = True
End If
'Pour éviter que la boucle continue même après que l'on ai trouvé les OD on sort de la boucle
'dès que FoundO et FoundD sont vraies
If FoundO = True And FoundD = True Then Exit For
BypassT:
On Error GoTo 0
Next Y
'Dans cette partie on inscrit une alerte en collonne K si une ou les deux gares sont introuvables
If FoundO = False And FoundD = True Then
ThisWorkbook.Worksheets("Général").Range("K" & K + 6).Value = "Gare origine (" & GareOBA & ") Introuvable"
End If
If FoundD = False And FoundO = True Then
ThisWorkbook.Worksheets("Général").Range("K" & K + 6).Value = "Gare destination (" & GareDBA & ") Introuvable"
End If
If FoundD = False And FoundO = False Then
ThisWorkbook.Worksheets("Général").Range("K" & K + 6).Value = "Gares Introuvables"
End If
Else
'Si le train en cours de recherche est différent de celui affiché dans la table de résultat
'on inscrit une alerte en K
ThisWorkbook.Worksheets("Général").Range("K" & K + 6).Value = "Train " & TabMarche(K, 0) & " Introuvable"
End If
Else
'Si la recherche du train échoue on inscrit une alerte en K
ThisWorkbook.Worksheets("Général").Range("K" & K + 6).Value = "Train " & TabMarche(K, 0) & " Introuvable"
End If
'Bloc de test du bouton annuler
If WaitBox.Annuler.Cancel = True Then
Call Annulation(IE)
Exit Function
End If
Next
'On copie le contenu du tableau "TabMarche" dans la feuille principale
With ThisWorkbook.Worksheets("Général")
Application.ScreenUpdating = False
For K = 0 To UBound(TabMarche)
.Range("F" & K + 6).Value = TabMarche(K, 1)
.Range("G" & K + 6).Value = TabMarche(K, 2)
Next
Application.ScreenUpdating = True
End With
'MAJ WaitBox
WaitBox.ProgressBar1.Max = 1
WaitBox.ProgressBar1.Value = 1
WaitBox.Repaint
Exit Function
'Gestion d'erreurs de recherche Base assistance
ErrorHandler:
Select Case Err.Number
'Gestion de l'erreur 70 : Accès refusé; qui provient d'un problème de vitesse d'execution
Case 70
'Pause en ms
Sleep 200
'WaitIE IE
'Retour à la ligne qui à l'origine l'erreur
Resume
'Autre problème de vitesse d'execution
Case 91
Sleep 200
'WaitIE IE
Resume BypassT
'Erreur de membre introuvable
Case 461
NbErr2 = NbErr2 + 1
'Si cette erreur se répète plus de 2 fois, on arrête la recherche
If NbErr2 > 2 Then
Call ProcErrmsg(300, "Erreur de lecture des données!" & vbCrLf & "Redémarrez la macro au " & DateBA, IE)
Else
Resume
End If
'Gestion d'erreurs autres
Case Is <> 0
Sleep 200
'WaitIE IE
NbErr = NbErr + 1
'Si une erreur non identifiée se répète plus de 4 fois, on arrête la recherche
If NbErr > 4 Then
Call ProcErrmsg(301, "Occurrences d'erreurs inattendues !" & vbCrLf & "Redémarrez la macro au " & DateBA, IE)
Else
Resume
End If
End Select
End Function |
