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
|
Public Sub recup_taux_euribor12m()
Dim lienInternet As SHDocVw.InternetExplorer
Dim pageInternet As MSHTML.HTMLDocument
Dim leTaux As MSHTML.HTMLSpanElement
Dim cadre_calendrier As MSHTML.HTMLFormElement
Dim calendrier As MSHTML.HTMLGenericElement
Dim dateRecup As String
Dim dateRecup2 As String
Dim tauxWeb As String
Dim tauxeuribor12m As Double
'Dim bouton As MSHTML.HTMLDocument
Set lienInternet = New SHDocVw.InternetExplorer
lienInternet.Visible = True
lienInternet.navigate "http://www.boursorama.com/cours.phtml?symbole=1xEUR8Y&vue=histo"
' Attente avec timeout de 10 s
If WaitIE(lienInternet, 10) Then
' 10 s écoulées et page non chargée
MsgBox "Time out!"
Else
' Page chargée, on continue
Set pageInternet = lienInternet.Document
' On clique sur le calendrier
Set calendrier = pageInternet.all("span_date_cal")
dateRecup = calendrier.innerText
'On affiche le texte
MsgBox dateRecup, Title:="la date est"
'on change la date
' Valeur recherchée
'pageInternet.parentWindow.execScript "showCalendar('date_cal', '%Y-%m-%d', true, 'span_date_cal')", "JavaScript"
pageInternet.parentWindow.execScript "$('form').submit(dateRecup)", "JavaScript"
pageInternet.parentWindow.execScript "$('form').submit()", "JavaScript"
'pageInternet.parentWindow.execScript "showCalendar('date_cal', '%Y-%m-%d', true, 'dateRecup')", "JavaScript"
'On exécute le script showActu 'Attention à la Casse!!!! showActu
'IEDoc.parentWindow.execScript "showCalendar(" & yNumActu & ")", "JavaScript" code du tuto
'dateRecup2 = calendrier.innerText
'On affiche le texte
MsgBox dateRecup2, Title:="la date est"
'on recalcule le taux sur le site
'Set calendrier = pageInternet.all("span_date_cal")
'calendrier.Click
End If
End Sub
' Attend que la page internet soit chargée
' pTimeOut est un time out en secondes (WaitIE vaut True si Timeout)
Public Function WaitIE(oIE As InternetExplorer, Optional pTimeOut As Long = 0) As Boolean
Dim lTimer As Double
lTimer = Timer
Do
DoEvents
If oIE.readyState = READYSTATE_COMPLETE And Not oIE.Busy Then Exit Do
If pTimeOut > 0 And Timer - lTimer > pTimeOut Then
WaitIE = True
Exit Do
End If
Loop
End Function
' Recherche d'un bouton par son nom dans le document
Private Function GetButton(Document As HTMLDocument, ButtonId As String) As MSHTML.HTMLInputElement
If Document.getElementById(ButtonId).Length > 1 Then
Set GetButton = Document.getElementById(ButtonId)(1)
Else
Set GetButton = Document.getElementsById(ButtonId)(0)
End If
End Function |
Partager