téléchargement des cours / des codes reuters-sico-isin...

Zone d'échange de sources C, C++, Java, VB, VBA et autres...

Modérateur : webmaster

fx.z
Messages : 7
Enregistré le : 21/06/2011 14:37

Message par fx.z » 21/07/2011 10:01

Bonjour
et encore merci

J'ai toujours la meme erreur 0
je suis derriere un proxy mais je n'arrive pas à modifier la fonc internetopen
mon accès proxy public serait :
InternetOpen("test", INTERNET_OPEN_TYPE_PROXY, "192.168.20.8", "8080", 0);

Merci pour l'aide

fx.z
Messages : 7
Enregistré le : 21/06/2011 14:37

Message par fx.z » 21/07/2011 14:55

Je viens de réussir à intégrer la redirection du proxy, en revanche j'essaye d'intégrer la liste des obligations d'euronext
http://www.euronext.com/trader/pricesli ... &goBtn.y=3
mais la feuille valeurs ne les prends pas

Avatar du membre
webmaster
Messages : 769
Enregistré le : 14/06/2003 15:21
Contact :

Message par webmaster » 21/07/2011 23:14

Bonjour,

Content de savoir que ça fonctionne finalement. Pouvez-vous nous dire ce que vous avez modifié pour intégrer le proxy ?

Pour ce qui concerne les obligations, c'est normal que la feuille valeurs ne les prenne pas car le format d'affichage n'est pas le même que celui des actions. Il faudrait donc écrire une fonction recupereCours spécifique, ou rendre celle existante paramétrable pour qu'elle puisse traiter les deux formats. Si je trouve le temps je le ferai.

Webmaster

fx.z
Messages : 7
Enregistré le : 21/06/2011 14:37

Message par fx.z » 26/07/2011 10:01

Bonjour,


voici le code modifié

Option Explicit
'==============================================================================
' Import des fonction Wininet et Kernel32 necessaires
'==============================================================================
Public Declare Function InternetOpen Lib "wininet" 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 InternetCloseHandle Lib "wininet" _
(ByVal hInet As Long) As Integer

Public Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" _
(ByVal hInternetSession 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function InternetReadFile Lib "wininet" _
(ByVal hFile As Long, ByVal sBuffer As String, _
ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" _
(lpdwError As Long, ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function FormatMessage Lib "kernel32" _
Alias "FormatMessageA" ( _
ByVal dwFlags As Long, _
ByVal lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
ByRef Arguments As Long) As Long
'==============================================================================
' Déclarations de constantes
'==============================================================================
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const COLONNE_COURS_CLOTURE = 3
Public Const COLONNE_CODE_ISIN = 1
' ----- Constantes utiles pour FormatMessage -----
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Long = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Long = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800
Private Const FORMAT_MESSAGE_FROM_STRING As Long = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = &HFF
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
Private Const FORMAT_MESSAGE_TEXT_LEN As Long = &HA0

'******************************************************************************
'* Macro telechargerCours *
'******************************************************************************
'* *
'* Description : cette macro cree une feuille 'Valeurs' a la fin du classeur *
'* courant, puis recupere les cours de differents marches. *
'* *
'******************************************************************************
Sub telechargeCours()
' ----- On efface le contenu de la feuille des valeurs -----
Dim bValeurs As Boolean
Dim i As Integer
Dim s As Worksheet
bValeurs = False
For i = 1 To Sheets.Count
If (Sheets(i).Name = "Valeurs") Then
bValeurs = True
End If
Next i
Application.DisplayAlerts = False
If (bValeurs = True) Then
Worksheets("Valeurs").Delete
End If
Set s = Sheets.Add(After:=Worksheets(Worksheets.Count))
s.Name = "Valeurs"
Application.DisplayAlerts = True
Dim iPage As Integer
'Toutes actions Euronext
iPage = 1
While (iPage <> -1)
iPage = recupereCours("http://www.euronext.com/trader/pricesli ... pageIndex=" + Format(iPage), iPage)
Wend
' Alternext
iPage = 1
While (iPage <> -1)
iPage = recupereCours("http://www.euronext.com/alternext/price ... pageIndex=" + Format(iPage), iPage)
Wend
' Marche Libre
iPage = 1
While (iPage <> -1)
iPage = recupereCours("http://www.euronext.com/trader/pricesli ... pageIndex=" + Format(iPage), iPage)
Wend
' Trackers
iPage = 1
While (iPage <> -1)
iPage = recupereCours("http://www.euronext.com/trader/pricesli ... dexFamily=", iPage)
Wend
' Provoquer le recalcul de l'ensemble du classeur pour prise en compte des nouveaux cours
Application.CalculateFull
End Sub


'******************************************************************************
'* Fonction getCoursValeur *
'******************************************************************************
'* *
'* Description : cette fonction renvoie le cours de cloture d'une valeur en *
'* fonction de son code ISIN. Pour ce faire, elle cherche la *
'* valeur dans la feuille 'Valeurs' du classeur courant. *
'* *
'* Entree : szCodeISIN = code ISIN de la valeur dont on souhaite connaitre le *
'* cours de cloture. *
'* *
'* Sortie : Neant. *
'* *
'* Retour : cours de cloture ou '?' si valeur non trouvee. *
'* *
'******************************************************************************
Function getCoursValeur(szCodeISIN As String) As Double
' On cherche le code dans la feuille 'Valeurs'
Dim iLigne As Integer
iLigne = 1
While (Worksheets("Valeurs").Cells(iLigne, COLONNE_CODE_ISIN).Value <> "" And _
Worksheets("Valeurs").Cells(iLigne, COLONNE_CODE_ISIN).Value <> szCodeISIN)
iLigne = iLigne + 1
Wend
If Worksheets("Valeurs").Cells(iLigne, COLONNE_CODE_ISIN).Value = "" Then
getCoursValeur = "?"
Exit Function
End If
getCoursValeur = Worksheets("Valeurs").Cells(iLigne, COLONNE_COURS_CLOTURE).Value
End Function

'******************************************************************************
'* Fonction recupereCours *
'******************************************************************************
'* *
'* Description : cette fonction recupere une page sur le site Euronext, en *
'* extrait les intitulés, codes et cours des valeurs et renvoie *
'* eventuellement la page suivante si il y en a une. *
'* Les intitulés, codes et cours des valeurs sont ajoutées dans *
'* la feuille 'valeurs' du classeur courant. *
'* *
'* Entree : URL des donnees a recuperer. *
'* *
'* Sortie : ajout de lignes dans la feuille 'Valeurs' du classeur. *
'* *
'* Retour : numero de la page suivante (parametre 'pageIndex' Euronext). *
'* *
'******************************************************************************
Function recupereCours(szUrl As String, iPage As Integer) As Integer
Dim hInternetSession As Long ' handle de la session internet
Dim hPage As Long ' handle de la page
Dim i As Integer
Dim iPageSuivante As Integer
'------ On ouvre une connexion -----
hInternetSession = InternetOpen("Wininet", INTERNET_OPEN_TYPE_PROXY, "http://192.168.20.8:8080", vbNullString, 0)
If (hInternetSession <> 0) Then
' ----- On ouvre la page demandee -----
hPage = InternetOpenUrl(hInternetSession, szUrl, vbNullString, 0, _
INTERNET_FLAG_RELOAD, 0)
If (hPage <> 0) Then
Dim szBuffer As String * 32000 ' Buffer pour lecture de la page
Dim lNbOctLus As Long ' Pour recevoir le nombre d'octets lus
Dim lTaillePage As Long ' Pour stocker la taille de la page
Dim bRet As Boolean ' Pour le code de retour de la lecture
Dim iLigne As Integer
Dim iColonne As Integer
Dim szPage As String

' ----- On cherche la premiere ligne vide -----
iLigne = 1
iColonne = 1
While (Worksheets("Valeurs").Cells(iLigne, iColonne).Value <> "")
iLigne = iLigne + 1
Wend

' ----- On lit le contenu de la page -----
szPage = vbNullString
lTaillePage = 0
Do
szBuffer = vbNullString
lNbOctLus = 0
bRet = InternetReadFile(hPage, szBuffer, 32000, lNbOctLus)
If (bRet = True And lNbOctLus > 0) Then
szPage = szPage & Mid$(szBuffer, 1, lNbOctLus)
lTaillePage = lTaillePage + lNbOctLus
Else
If bRet = False Then
AfficheErreurInternet ("InternetReadFile")
End If
End If
Loop While (bRet = True And lNbOctLus <> 0)

' ----- On ferme le handle de la page -----
CloseHandle (hPage)

' ----- On sauve la page pour trace -----
' Open "c:\temp\trackers.htm" For Output As #1
' Write #1, szPage
' Close #1


Dim iDeb As Long ' pointeur dans la page
iDeb = 1

' ----- On cherche le debut des donnees qui nous interessent -----
' deb = InStr(iDeb, szPage, "<td class=" + Chr(34) + "tableHeader" + Chr(34) + " colspan=" + Chr(34) + "3" + Chr(34) + ">Libellé</td>")

'While (InStr(iDeb, szPage, "<td class=" + Chr(34) + "tableBgColor2" + Chr(34) + "><span class=" + _
' Chr(34) + "tableValueName" + Chr(34) + ">") _
' And _
' InStr(iDeb, szPage, "?isinCode="))
While (InStr(iDeb, szPage, "<a href=" + Chr(34) + "/trader/summarizedmarket/summarizedmarketRoot.jsp?") <> 0 _
And _
(InStr(iDeb, szPage, "&amp;isinCode=") <> 0 Or InStr(iDeb, szPage, "&isinCode=") <> 0 Or InStr(iDeb, szPage, "?isinCode=") <> 0))
Dim deb As Long
Dim deb1 As Long
Dim fin As Long
Dim szCodeISIN As String
Dim szNom As String
Dim szCours As String
Dim bAmpCourt As Boolean

deb = InStr(iDeb, szPage, "<a href=" + Chr(34) + "/trader/summarizedmarket/summarizedmarketRoot.jsp?")
If (deb <> 0) Then
iDeb = deb + Len("<a href=" + Chr(34) + "/trader/summarizedmarket/summarizedmarketRoot.jsp?") - 1
End If
bAmpCourt = False
deb = InStr(iDeb, szPage, "&amp;isinCode=")
If deb = 0 Then
deb = InStr(iDeb, szPage, "&isinCode=")
bAmpCourt = True
End If
If deb = 0 Then
deb = InStr(iDeb, szPage, "?isinCode=")
bAmpCourt = True
End If
If (deb <> 0) Then
' Code ISIN
If bAmpCourt = True Then deb = deb + Len("&isinCode=") Else deb = deb + Len("&amp;isinCode=")
'fin = InStr(deb, szPage, Chr(34) + ">")
fin = deb + 12
szCodeISIN = Mid$(szPage, deb, fin - deb)
Worksheets("Valeurs").Cells(iLigne, iColonne).Value = szCodeISIN
iColonne = iColonne + 1
iDeb = fin
' Nom
deb = InStr(iDeb, szPage, ">")
deb = deb + 1
fin = InStr(deb, szPage, "</a>")
szNom = Mid$(szPage, deb, fin - deb)
Worksheets("Valeurs").Cells(iLigne, iColonne).Value = szNom
iColonne = iColonne + 1
iDeb = fin
' Cours
deb = InStr(iDeb, szPage, "class=" + Chr(34) + "tableValueNumRight" + Chr(34) + ">")
If deb <> 0 Then
deb = deb + Len("class=" + Chr(34) + "tableValueNumRight" + Chr(34) + ">")
End If
deb1 = InStr(deb, szPage, "<a class=" + Chr(34) + "fc1" + Chr(34) + " title=")
If deb1 <> 0 Then
deb1 = deb1 + Len("<a class=" + Chr(34) + "fc1" + Chr(34) + "title=")
While Mid$(szPage, deb1, 1) <> ">"
deb1 = deb1 + 1
Wend
deb = deb1 + 1
End If
szCours = vbNullString
While ((Mid$(szPage, deb, 1) >= "0" And Mid$(szPage, deb, 1) <= "9") Or Mid$(szPage, deb, 1) = ".")
szCours = szCours & Mid$(szPage, deb, 1)
deb = deb + 1
Wend
Worksheets("Valeurs").Cells(iLigne, iColonne).Value = szCours
iDeb = fin
' Ligne suivante
iColonne = 1
iLigne = iLigne + 1
End If
Wend

Else
AfficheErreurInternet ("InternetOpenUrl")
End If

' ----- Et on regarde si il y a une page suivante -----
Dim SZ_PAGE_INDEX As String
SZ_PAGE_INDEX = "pageIndex="
iPageSuivante = -1
If (InStr(iDeb, szPage, SZ_PAGE_INDEX)) Then
While (InStr(iDeb, szPage, SZ_PAGE_INDEX) And iPageSuivante <= iPage)
' On va chercher le nombre situé après "pageIndex="
i = 0
iPageSuivante = 0
While (Mid$(szPage, InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX) + i, 1) >= "0" And Mid$(szPage, InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX) + i, 1) <= "9")
iPageSuivante = iPageSuivante * 10 + Mid$(szPage, InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX) + i, 1)
i = i + 1
Wend
'iPageSuivante = Mid$(szPage, InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX), InStr(InStr(iDeb, szPage, SZ_PAGE_INDEX), szPage, "&") - (InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX)))
iDeb = InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX) + i
Wend
If iPageSuivante <= iPage Then iPageSuivante = -1 ' Au cas où...
End If


' ----- On ferme la connexion -----
InternetCloseHandle (hInternetSession)

Else
AfficheErreur ("InternetOpen")
End If

' On fixe le code retour
recupereCours = iPageSuivante
End Function
'******************************************************************************
'* Fonction AfficheErreur *
'******************************************************************************
'* *
'* Description : cette fonction recupere l'origine d'une erreur et affiche *
'* le message d'erreur correspondant. *
'* *
'* Entree : szMsg = chaine a afficher dans le message d'erreur. *
'* *
'* Sortie : neant. *
'* *
'* Retour : neant. *
'* *
'******************************************************************************
Sub AfficheErreur(szMsg As String)
Dim lErr As Long
Dim sErr As String
Dim TextLen As Long
Dim FormatMessageResult As Long
Dim LangID As Long

LangID = 0& ' Default language
sErr = String$(FORMAT_MESSAGE_TEXT_LEN, vbNullChar)
TextLen = FORMAT_MESSAGE_TEXT_LEN

' On recupere la derniere erreur
lErr = GetLastError()
' On recupere le message correspondant a l'erreur
FormatMessageResult = FormatMessage( _
dwFlags:=FORMAT_MESSAGE_FROM_SYSTEM Or _
FORMAT_MESSAGE_IGNORE_INSERTS, _
lpSource:=0&, _
dwMessageId:=lErr, _
dwLanguageId:=LangID, _
lpBuffer:=sErr, _
nSize:=TextLen, _
Arguments:=0&)

If FormatMessageResult <> 0 Then
sErr = Left$(ErrorText, FormatMessageResult)
Else
sErr = "Erreur inconnue !"
End If

' On affiche l'erreur
MsgBox szMsg + vbCrLf + "Erreur " + CStr(lErr) + ": " + ErrorText, vbOKOnly + vbCritical

End Sub
'******************************************************************************
'* Fonction AfficheErreurInternet *
'******************************************************************************
'* *
'* Description : cette fonction recupere l'origine d'une erreur de l'API *
'* Wininet et affiche le message d'erreur correspondant. *
'* *
'* Entree : szMsg = chaine a afficher dans le message d'erreur. *
'* *
'* Sortie : neant. *
'* *
'* Retour : neant. *
'* *
'******************************************************************************
Sub AfficheErreurInternet(szMsg As String)
Dim lErr As Long, sErr As String, lenBuf As Long
' On recupere la taille du buffer necessaire pour le message d'erreur
InternetGetLastResponseInfo lErr, sErr, lenBuf

' On cree le buffer
sErr = String(lenBuf, 0)

' On recupere la derniere erreur avec le message correspondant
InternetGetLastResponseInfo lErr, sErr, lenBuf

' On affiche l'erreur
MsgBox szMsg + vbNewLine + "Erreur " + CStr(lErr) + ": " + sErr, vbOKOnly + vbCritical

End Sub

fx.z
Messages : 7
Enregistré le : 21/06/2011 14:37

Message par fx.z » 26/07/2011 10:01

Bonjour,


voici le code modifié

Option Explicit
'==============================================================================
' Import des fonction Wininet et Kernel32 necessaires
'==============================================================================
Public Declare Function InternetOpen Lib "wininet" 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 InternetCloseHandle Lib "wininet" _
(ByVal hInet As Long) As Integer

Public Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" _
(ByVal hInternetSession 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function InternetReadFile Lib "wininet" _
(ByVal hFile As Long, ByVal sBuffer As String, _
ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" _
(lpdwError As Long, ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function FormatMessage Lib "kernel32" _
Alias "FormatMessageA" ( _
ByVal dwFlags As Long, _
ByVal lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
ByRef Arguments As Long) As Long
'==============================================================================
' Déclarations de constantes
'==============================================================================
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const COLONNE_COURS_CLOTURE = 3
Public Const COLONNE_CODE_ISIN = 1
' ----- Constantes utiles pour FormatMessage -----
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Long = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Long = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800
Private Const FORMAT_MESSAGE_FROM_STRING As Long = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = &HFF
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
Private Const FORMAT_MESSAGE_TEXT_LEN As Long = &HA0

'******************************************************************************
'* Macro telechargerCours *
'******************************************************************************
'* *
'* Description : cette macro cree une feuille 'Valeurs' a la fin du classeur *
'* courant, puis recupere les cours de differents marches. *
'* *
'******************************************************************************
Sub telechargeCours()
' ----- On efface le contenu de la feuille des valeurs -----
Dim bValeurs As Boolean
Dim i As Integer
Dim s As Worksheet
bValeurs = False
For i = 1 To Sheets.Count
If (Sheets(i).Name = "Valeurs") Then
bValeurs = True
End If
Next i
Application.DisplayAlerts = False
If (bValeurs = True) Then
Worksheets("Valeurs").Delete
End If
Set s = Sheets.Add(After:=Worksheets(Worksheets.Count))
s.Name = "Valeurs"
Application.DisplayAlerts = True
Dim iPage As Integer
'Toutes actions Euronext
iPage = 1
While (iPage <> -1)
iPage = recupereCours("http://www.euronext.com/trader/pricesli ... pageIndex=" + Format(iPage), iPage)
Wend
' Alternext
iPage = 1
While (iPage <> -1)
iPage = recupereCours("http://www.euronext.com/alternext/price ... pageIndex=" + Format(iPage), iPage)
Wend
' Marche Libre
iPage = 1
While (iPage <> -1)
iPage = recupereCours("http://www.euronext.com/trader/pricesli ... pageIndex=" + Format(iPage), iPage)
Wend
' Trackers
iPage = 1
While (iPage <> -1)
iPage = recupereCours("http://www.euronext.com/trader/pricesli ... dexFamily=", iPage)
Wend
' Provoquer le recalcul de l'ensemble du classeur pour prise en compte des nouveaux cours
Application.CalculateFull
End Sub


'******************************************************************************
'* Fonction getCoursValeur *
'******************************************************************************
'* *
'* Description : cette fonction renvoie le cours de cloture d'une valeur en *
'* fonction de son code ISIN. Pour ce faire, elle cherche la *
'* valeur dans la feuille 'Valeurs' du classeur courant. *
'* *
'* Entree : szCodeISIN = code ISIN de la valeur dont on souhaite connaitre le *
'* cours de cloture. *
'* *
'* Sortie : Neant. *
'* *
'* Retour : cours de cloture ou '?' si valeur non trouvee. *
'* *
'******************************************************************************
Function getCoursValeur(szCodeISIN As String) As Double
' On cherche le code dans la feuille 'Valeurs'
Dim iLigne As Integer
iLigne = 1
While (Worksheets("Valeurs").Cells(iLigne, COLONNE_CODE_ISIN).Value <> "" And _
Worksheets("Valeurs").Cells(iLigne, COLONNE_CODE_ISIN).Value <> szCodeISIN)
iLigne = iLigne + 1
Wend
If Worksheets("Valeurs").Cells(iLigne, COLONNE_CODE_ISIN).Value = "" Then
getCoursValeur = "?"
Exit Function
End If
getCoursValeur = Worksheets("Valeurs").Cells(iLigne, COLONNE_COURS_CLOTURE).Value
End Function

'******************************************************************************
'* Fonction recupereCours *
'******************************************************************************
'* *
'* Description : cette fonction recupere une page sur le site Euronext, en *
'* extrait les intitulés, codes et cours des valeurs et renvoie *
'* eventuellement la page suivante si il y en a une. *
'* Les intitulés, codes et cours des valeurs sont ajoutées dans *
'* la feuille 'valeurs' du classeur courant. *
'* *
'* Entree : URL des donnees a recuperer. *
'* *
'* Sortie : ajout de lignes dans la feuille 'Valeurs' du classeur. *
'* *
'* Retour : numero de la page suivante (parametre 'pageIndex' Euronext). *
'* *
'******************************************************************************
Function recupereCours(szUrl As String, iPage As Integer) As Integer
Dim hInternetSession As Long ' handle de la session internet
Dim hPage As Long ' handle de la page
Dim i As Integer
Dim iPageSuivante As Integer
'------ On ouvre une connexion -----
hInternetSession = InternetOpen("Wininet", INTERNET_OPEN_TYPE_PROXY, "http://192.168.20.8:8080", vbNullString, 0)
If (hInternetSession <> 0) Then
' ----- On ouvre la page demandee -----
hPage = InternetOpenUrl(hInternetSession, szUrl, vbNullString, 0, _
INTERNET_FLAG_RELOAD, 0)
If (hPage <> 0) Then
Dim szBuffer As String * 32000 ' Buffer pour lecture de la page
Dim lNbOctLus As Long ' Pour recevoir le nombre d'octets lus
Dim lTaillePage As Long ' Pour stocker la taille de la page
Dim bRet As Boolean ' Pour le code de retour de la lecture
Dim iLigne As Integer
Dim iColonne As Integer
Dim szPage As String

' ----- On cherche la premiere ligne vide -----
iLigne = 1
iColonne = 1
While (Worksheets("Valeurs").Cells(iLigne, iColonne).Value <> "")
iLigne = iLigne + 1
Wend

' ----- On lit le contenu de la page -----
szPage = vbNullString
lTaillePage = 0
Do
szBuffer = vbNullString
lNbOctLus = 0
bRet = InternetReadFile(hPage, szBuffer, 32000, lNbOctLus)
If (bRet = True And lNbOctLus > 0) Then
szPage = szPage & Mid$(szBuffer, 1, lNbOctLus)
lTaillePage = lTaillePage + lNbOctLus
Else
If bRet = False Then
AfficheErreurInternet ("InternetReadFile")
End If
End If
Loop While (bRet = True And lNbOctLus <> 0)

' ----- On ferme le handle de la page -----
CloseHandle (hPage)

' ----- On sauve la page pour trace -----
' Open "c:\temp\trackers.htm" For Output As #1
' Write #1, szPage
' Close #1


Dim iDeb As Long ' pointeur dans la page
iDeb = 1

' ----- On cherche le debut des donnees qui nous interessent -----
' deb = InStr(iDeb, szPage, "<td class=" + Chr(34) + "tableHeader" + Chr(34) + " colspan=" + Chr(34) + "3" + Chr(34) + ">Libellé</td>")

'While (InStr(iDeb, szPage, "<td class=" + Chr(34) + "tableBgColor2" + Chr(34) + "><span class=" + _
' Chr(34) + "tableValueName" + Chr(34) + ">") _
' And _
' InStr(iDeb, szPage, "?isinCode="))
While (InStr(iDeb, szPage, "<a href=" + Chr(34) + "/trader/summarizedmarket/summarizedmarketRoot.jsp?") <> 0 _
And _
(InStr(iDeb, szPage, "&amp;isinCode=") <> 0 Or InStr(iDeb, szPage, "&isinCode=") <> 0 Or InStr(iDeb, szPage, "?isinCode=") <> 0))
Dim deb As Long
Dim deb1 As Long
Dim fin As Long
Dim szCodeISIN As String
Dim szNom As String
Dim szCours As String
Dim bAmpCourt As Boolean

deb = InStr(iDeb, szPage, "<a href=" + Chr(34) + "/trader/summarizedmarket/summarizedmarketRoot.jsp?")
If (deb <> 0) Then
iDeb = deb + Len("<a href=" + Chr(34) + "/trader/summarizedmarket/summarizedmarketRoot.jsp?") - 1
End If
bAmpCourt = False
deb = InStr(iDeb, szPage, "&amp;isinCode=")
If deb = 0 Then
deb = InStr(iDeb, szPage, "&isinCode=")
bAmpCourt = True
End If
If deb = 0 Then
deb = InStr(iDeb, szPage, "?isinCode=")
bAmpCourt = True
End If
If (deb <> 0) Then
' Code ISIN
If bAmpCourt = True Then deb = deb + Len("&isinCode=") Else deb = deb + Len("&amp;isinCode=")
'fin = InStr(deb, szPage, Chr(34) + ">")
fin = deb + 12
szCodeISIN = Mid$(szPage, deb, fin - deb)
Worksheets("Valeurs").Cells(iLigne, iColonne).Value = szCodeISIN
iColonne = iColonne + 1
iDeb = fin
' Nom
deb = InStr(iDeb, szPage, ">")
deb = deb + 1
fin = InStr(deb, szPage, "</a>")
szNom = Mid$(szPage, deb, fin - deb)
Worksheets("Valeurs").Cells(iLigne, iColonne).Value = szNom
iColonne = iColonne + 1
iDeb = fin
' Cours
deb = InStr(iDeb, szPage, "class=" + Chr(34) + "tableValueNumRight" + Chr(34) + ">")
If deb <> 0 Then
deb = deb + Len("class=" + Chr(34) + "tableValueNumRight" + Chr(34) + ">")
End If
deb1 = InStr(deb, szPage, "<a class=" + Chr(34) + "fc1" + Chr(34) + " title=")
If deb1 <> 0 Then
deb1 = deb1 + Len("<a class=" + Chr(34) + "fc1" + Chr(34) + "title=")
While Mid$(szPage, deb1, 1) <> ">"
deb1 = deb1 + 1
Wend
deb = deb1 + 1
End If
szCours = vbNullString
While ((Mid$(szPage, deb, 1) >= "0" And Mid$(szPage, deb, 1) <= "9") Or Mid$(szPage, deb, 1) = ".")
szCours = szCours & Mid$(szPage, deb, 1)
deb = deb + 1
Wend
Worksheets("Valeurs").Cells(iLigne, iColonne).Value = szCours
iDeb = fin
' Ligne suivante
iColonne = 1
iLigne = iLigne + 1
End If
Wend

Else
AfficheErreurInternet ("InternetOpenUrl")
End If

' ----- Et on regarde si il y a une page suivante -----
Dim SZ_PAGE_INDEX As String
SZ_PAGE_INDEX = "pageIndex="
iPageSuivante = -1
If (InStr(iDeb, szPage, SZ_PAGE_INDEX)) Then
While (InStr(iDeb, szPage, SZ_PAGE_INDEX) And iPageSuivante <= iPage)
' On va chercher le nombre situé après "pageIndex="
i = 0
iPageSuivante = 0
While (Mid$(szPage, InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX) + i, 1) >= "0" And Mid$(szPage, InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX) + i, 1) <= "9")
iPageSuivante = iPageSuivante * 10 + Mid$(szPage, InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX) + i, 1)
i = i + 1
Wend
'iPageSuivante = Mid$(szPage, InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX), InStr(InStr(iDeb, szPage, SZ_PAGE_INDEX), szPage, "&") - (InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX)))
iDeb = InStr(iDeb, szPage, SZ_PAGE_INDEX) + Len(SZ_PAGE_INDEX) + i
Wend
If iPageSuivante <= iPage Then iPageSuivante = -1 ' Au cas où...
End If


' ----- On ferme la connexion -----
InternetCloseHandle (hInternetSession)

Else
AfficheErreur ("InternetOpen")
End If

' On fixe le code retour
recupereCours = iPageSuivante
End Function
'******************************************************************************
'* Fonction AfficheErreur *
'******************************************************************************
'* *
'* Description : cette fonction recupere l'origine d'une erreur et affiche *
'* le message d'erreur correspondant. *
'* *
'* Entree : szMsg = chaine a afficher dans le message d'erreur. *
'* *
'* Sortie : neant. *
'* *
'* Retour : neant. *
'* *
'******************************************************************************
Sub AfficheErreur(szMsg As String)
Dim lErr As Long
Dim sErr As String
Dim TextLen As Long
Dim FormatMessageResult As Long
Dim LangID As Long

LangID = 0& ' Default language
sErr = String$(FORMAT_MESSAGE_TEXT_LEN, vbNullChar)
TextLen = FORMAT_MESSAGE_TEXT_LEN

' On recupere la derniere erreur
lErr = GetLastError()
' On recupere le message correspondant a l'erreur
FormatMessageResult = FormatMessage( _
dwFlags:=FORMAT_MESSAGE_FROM_SYSTEM Or _
FORMAT_MESSAGE_IGNORE_INSERTS, _
lpSource:=0&, _
dwMessageId:=lErr, _
dwLanguageId:=LangID, _
lpBuffer:=sErr, _
nSize:=TextLen, _
Arguments:=0&)

If FormatMessageResult <> 0 Then
sErr = Left$(ErrorText, FormatMessageResult)
Else
sErr = "Erreur inconnue !"
End If

' On affiche l'erreur
MsgBox szMsg + vbCrLf + "Erreur " + CStr(lErr) + ": " + ErrorText, vbOKOnly + vbCritical

End Sub
'******************************************************************************
'* Fonction AfficheErreurInternet *
'******************************************************************************
'* *
'* Description : cette fonction recupere l'origine d'une erreur de l'API *
'* Wininet et affiche le message d'erreur correspondant. *
'* *
'* Entree : szMsg = chaine a afficher dans le message d'erreur. *
'* *
'* Sortie : neant. *
'* *
'* Retour : neant. *
'* *
'******************************************************************************
Sub AfficheErreurInternet(szMsg As String)
Dim lErr As Long, sErr As String, lenBuf As Long
' On recupere la taille du buffer necessaire pour le message d'erreur
InternetGetLastResponseInfo lErr, sErr, lenBuf

' On cree le buffer
sErr = String(lenBuf, 0)

' On recupere la derniere erreur avec le message correspondant
InternetGetLastResponseInfo lErr, sErr, lenBuf

' On affiche l'erreur
MsgBox szMsg + vbNewLine + "Erreur " + CStr(lErr) + ": " + sErr, vbOKOnly + vbCritical

End Sub

Avatar du membre
webmaster
Messages : 769
Enregistré le : 14/06/2003 15:21
Contact :

Message par webmaster » 01/02/2012 22:25

Bonsoir,

Le site d'Euronext vient de migrer vers le domaine nyx.com...

...qui présente ce soir une réponse de type erreur 500 (internal server error) sur la plupart des requêtes !

Le site de l'ex-SBF était une sorte de labyrinthe. Le site Euronext avait ajouté au moins deux dimensions au labyrinthe et le nouveau site nyx semble très prometteur ! Le choix du français par exemple donne des résultats assez drôles lorsqu'on arrive à éviter l'erreur 500 !

Bref, une nouvelle version de la macro de récupération des cours dès que nos amis de Nyse-Euronext auront décoincé leur site "revampé" !

Webmaster

fists
Messages : 1
Enregistré le : 30/07/2012 12:32
Localisation : France

Message par fists » 30/07/2012 12:35

Bonjour,

Petit UP sur ce message.
Il fonctionne à merveille seulement pour mon besoin, il doit manquer quelque chose.

Par exemple, je ne veux récupérer que quelques valeurs (NICOX, SOITEC) par exemple et du coup faire dans le code un truc du genre :

iPage = recupereCours("http://www.euronext.com/trader/pricesli ... 0000074130", iPage) // FR0000074130 correspondant à NICOX.

Une idée?

Merci bien :)
Michaël.

Répondre

Qui est en ligne

Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 1 invité