Comment aller chercher des valeurs sur des pages web?

Bonjour aussi

lolo <lolo@nomail.com> a confié :
| je voudrais rapatrier sur une base access des cours de bourse à
| intervalles réguliers sur boursorama par exemple (genre toutes les
| heures) en se vbasant sur ce type de page:
| http://www.boursorama.com/cours.phtml?symbole=1rPFP&vue=full
| merci par avance
| lolo

Tu peux essayer la fonction suivante, à coupler à une fonction pour épurer le résultat.
Attention : lors de mes tests, j'ai eu un fonctionnement instable
(premier résultat ok, parfois le second, mais ensuite blocage => fin de tâche).
Comme si on devait rajouter quelques doevents quelque part et surtout comme si
la fermeture de l'Url et de la "session" internet ne se faisaient pas correctement.

Je décline toute responsabilité blabla ;-)


Option Compare Database
Option Explicit

Const INTERNET_FLAG_RELOAD = &H80000000

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Declare Function InternetCloseHandle _
Lib "wininet" _
(ByRef hInet As Long) As Long
Public 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
Public 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
Public Declare Function InternetOpenUrl _
Lib "wininet.dll" _
Alias "InternetOpenUrlA" _
(ByVal hInternet As Long, _
ByVal lpszUrl As String, _
ByVal lpszHeaders As String, _
ByVal dwHeadersLength As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
Public Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hFtpSession As Long, _
ByVal strBuffer As String, _
ByVal lngLengthBuffer As Long, _
lngBytesRead As Long) As Boolean

Dim hConnection As Long
Dim hOpen As Long
Dim hFile As Long
Dim lRet As Long

Function fReadInURL(strURL As String, Optional BufferSize As Long = 1000) As String
Dim sBuffer As String
sBuffer = Space(BufferSize)
hOpen = InternetOpen("HTTPTest", 1, vbNullString, _
vbNullString, 0)
hFile = InternetOpenUrl(hOpen, strURL, vbNullString, _
ByVal 0&, INTERNET_FLAG_RELOAD, _
ByVal 0&)
InternetReadFile hFile, sBuffer, Len(sBuffer), lRet
InternetCloseHandle hFile
InternetCloseHandle hOpen
fReadInURL = sBuffer
End Function


Sub test()
Dim pos As Long
Dim strBuffer As String
strBuffer = fReadInURL("http://www.boursorama.com/cours.phtml?symbole=1rPFP&vue=full", 20000)
pos = InStr(1, strBuffer, "<TD>1</TD>", vbTextCompare)
msgbox Mid(strBuffer, pos, 130)

End Sub


--
à+
Arnaud
--------------------------------------------------
Conseils d'utilisation, sites recommandés :
http://users.skynet.be/mpfa/
Access Memorandum - http://memoaccess.free.fr
--------------------------------------------------