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