Extraction donnée dans tableau (requête HTTP)

Le 01/10/2015 à 10:53

Bonjour à tous !

Je me permets de créer un nouveau topic, j'ai cherché dans les forums pour voir si une solution existait mais je n'ai rien trouvé pour mon type de problème, je m'en remets donc à vous. Je suis novice sur VBA et j'ai repris un fichier d'un prédécesseur avec ses macros déjà faites. Je dois en créer de nouvelles.

J'explique ici le déroulement de ma sheet:

1) Je dois reccueillir des données provenant de différents sites boursiers (des indices principalement), et automatiser l'acquisition de ces valeurs journalières.

2) En colonnes dans ma sheet, tous les indices, et en lignes les dates

3) Le but de la manoeuvre est d'acquérir les données manquantes dans ma base de données. Ex: si la database est à jour jusqu'au 5 septembre, et que nous sommes le 1 octobre, la requête est censée aller rechercher les données manquantes du 6 à aujourd'hui.

4) Difficulté que j'éprouve: en intégrant de nouveaux sites, les codes sources changent et c'est là que je suis perdu, n'étant pas un AS en VBA ni en HTML.. :s

Voici donc mes codes:

Private Sub CommandButton1_Click()
cell = Lastcell

'adjust the amount of new data you need here

For cell = Lastcell To Lastcell + 1
Insertdate = Searchdate(GetXMLMSCIWORLD, Getcorrectdate(cell))
Insertdate = Replace(Insertdate, " ", "")
Insertvalue = Searchvalue(GetXMLMSCIWORLD, Getcorrectdate(cell))
Insertvalue3 = Searchvalue3(GetGoldINO, Getcorrectdate(cell))

Cells(cell + 1, 1) = Insertdate
Cells(cell + 1, 2) = Insertvalue
Cells(cell + 1, 3) = Insertvalue3

Next cell

End Sub

'--------------EVERYTHING OF MSCI DATABASE--------------

Private Function Lastcell()

'EVERYTHING OF MSCI WORLD

Dim lRow As Long
lRow = ActiveWorkbook.Worksheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Lastcell = lRow

End Function

Private Function GetXMLMSCIWORLD()
Dim objReq As WinHttp.WinHttpRequest
Set objReq = New WinHttp.WinHttpRequest
objReq.Option(WinHttpRequestOption_EnableRedirects) = True
objReq.Open "GET", "http://www.msci.com/webapp/indexperf/charts?baseValue=false&format=XML&frequency=D&endDate=03%20Nov%2C%202080&indices=106%2CC%2C36&scope=R&startDate=03%20Nov%2C%202013&site=gimi&currency=15&priceLevel=41", False
objReq.setRequestHeader "Cookie", "abcd=cookie:containing:colons"
objReq.send
GetXMLMSCIWORLD = objReq.ResponseText

End Function

Private Function Getcorrectdate(lRow)
date1 = Format(ActiveWorkbook.Worksheets("Feuil1").Cells(lRow, 1).Value, "mm-dd-yyyy")
Dim datum As String
datum = Format(date1, "mm-dd-yyyy")
Getcorrectdate = Replace(datum, "-", "/")

End Function

Private Function Searchdate(GetXMLMSCIWORLD As String, Getcorrectdate As String)
Dim CorrectDate As String
CorrectDate = Getcorrectdate
testarray = Split(GetXMLMSCIWORLD, CorrectDate)

Dim wy As String
wy = Replace(testarray(1), "<date>", "")
wy = Replace(wy, "</date>", "")
wy = Replace(wy, "<value>", "")
wy = Replace(wy, "</value>", "")
wy = Replace(wy, "</asOf>", "")
Dim secondArray() As String
secondArray = Split(wy, "<asOf>")
Dim py As Variant
py = Split(secondArray(1), vbLf)
Dim SearchdateBijna As String
SearchdateBijna = Format(py(1), "mm-dd-yyyy")
Searchdate = Format(SearchdateBijna, "mm-dd-yy")

End Function

Private Function Searchvalue(GetXMLMSCIWORLD As String, Getcorrectdate As String)
Dim CorrectDate2 As String
CorrectDate2 = Getcorrectdate
TestArray2 = Split(GetXMLMSCIWORLD, CorrectDate2)

Dim zy As String
zy = Replace(TestArray2(1), "<date>", "")
zy = Replace(zy, "</date>", "")
zy = Replace(zy, "<value>", "")
zy = Replace(zy, "</value>", "")
zy = Replace(zy, "</asOf>", "")
Dim secondArray2() As String
secondArray2 = Split(zy, "<asOf>")
Dim xy As Variant
xy = Split(secondArray2(1), vbLf)
Searchvalue = xy(2)

End Function

Private Function GetGoldINO()

'EVERYTHING OF GOLD
Dim objReq As WinHttp.WinHttpRequest
Set objReq = New WinHttp.WinHttpRequest
objReq.Option(WinHttpRequestOption_EnableRedirects) = True
objReq.Open "GET", "http://club.ino.com/quotes/data/?q=1&ticket=7b6cc6d8bbg06a08e074068078068&s=FOREX_XAUUSDO&w=d&f=csv", False
objReq.setRequestHeader "Cookie", "abcd=cookie:containing:colons"
objReq.send
GetGoldINO = objReq.ResponseText

End Function

Private Function Searchvalue3(GetGoldINO As String, getcorrectdateINO As String)

Dim Correctdate3 As String
Correctdate3 = Format(getcorrectdateINO, "yyyymmdd")
testarray3 = Split(GetGoldINO, Correctdate3)

Dim zy3 As String

zy3 = testarray3(1)
zy3 = Replace(testarray3(1), ",,", "")
zy3 = Replace(zy3, ",0,0", "")

Searchvalue3 = zy3

End Function

Je n'ai sélectionné que 2 actifs, le MSCI World et le nouveau que j'essaie d'implémenter. Tous les autres sont similaires au MSCI et fonctionnent donc je n'ai pris que ceux nécessaires pour ne pas rendre les codes lourds (il y a plus de 200 indices et macros).

J'ai des difficultés avec le nouvel indice et ma fonction GetGoldINO. J'ai trouvé comme page source ce tableau :

J'ai essayé d'introduire la donnée "Last", la seule dont j'ai besoin. Mais je n'arrive pas à créer un code suffisant... . Dans ma cellule j'ai tout le tableau et je n'arrive pas à splitter uniquement la donnée relative à la date relative. Ex: le 10 septembre la macro doit reconnaitre la date du tableau, et introduire la valeur "Last" du 10 septembre dans ma sheet excel.

Voilà, j'espère que ma demande n'est pas inappropriée et qu'elle est complète, si ça n'est pas clair je peux essayer de la clarifier. En attendant, je vous remercie pour votre aide d'avance !

Le 08/12/2015 à 22:02

Salut Olivier,

La solution à ton problème est simplissime, mais comme tu n'as pas eu la polisse d'aller lire ma réponse sur ton autre fil, je pense que celui-ci pourra également attendre

Rechercher des sujets similaires à "extraction donnee tableau requete http"