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
|
Option Explicit
'Accept application/json, text/javascript, */*
'Accept-Encoding gzip, deflate
'Accept-Language fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3
'Connection keep - alive
'Host europeanequities.nyx.com
'Referer https://europeanequities.nyx.com/en/products/equities/FR0000120073-XPAR/quotes
'User-Agent Mozilla/5.0 (Windows NT 6.1; WOW64; rv:27.0) Gecko/20100101 Firefox/27.0
'X-Requested-With XMLHttpRequest
Sub testeXMLReq()
Application.ScreenUpdating = False
XMLReq "18/03/2011", "17/03/2014"
Application.ScreenUpdating = True
End Sub
'https://europeanequities.nyx.com/sites/europeanequities.nyx.com/modules/common/common_listings/custom/nyx_eu_listings/nyx_eu_listings_price_chart/pricechart/pricechart.php?q=historical_data&adjusted=1&from=1326758400000&to=1395360000000&isin=FR0000120073&mic=XPAR&dateFormat=d/m/Y
Sub XMLReq(DateDebut As String, DateFin As String)
'Il faut activer la bibliotheque Microsoft WinHTTP Service
Dim DemandeFichier As New MSXML2.xmlHttp
Dim URl As String
Dim texte, table
'On code l'URL avec les date de début et de Fin de période
URl = "https://europeanequities.nyx.com/sites/europeanequities.nyx.com/modules/common/common_listings/custom/nyx_eu_listings/nyx_eu_listings_price_chart/pricechart/pricechart.php?q=historical_data&adjusted=1&from="
URl = URl & CStr(Date2Long(CDate(DateDebut))) & "000&to="
URl = URl & CStr(Date2Long(CDate(DateFin))) & "000&isin=FR0000120073&mic=XPAR&dateFormat=d/m/Y"
'On génère la requête
DemandeFichier.Open "GET", URl & "?nocache= + Math.random()", False
DemandeFichier.setRequestHeader "Accept", "application/json, text/javascript, */*"
DemandeFichier.setRequestHeader "Accept-Encoding", "gzip , deflate"
DemandeFichier.setRequestHeader "Accept-Language", "fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3"
DemandeFichier.setRequestHeader "Connection", "keep -alive"
DemandeFichier.setRequestHeader "Host", "europeanequities.nyx.com"
DemandeFichier.setRequestHeader "Referer", "https://europeanequities.nyx.com/en/products/equities/FR0000120073-XPAR/quotes"
DemandeFichier.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:27.0) Gecko/20100101 Firefox/27.0"
'On l'exécute la requête
DemandeFichier.send
'le 3 eme argument dans le open concerne le ready state pas besoins de cette boucle
'On attent le chargemet des données
'Do
'DoEvents
'Loop While DemandeFichier.readyState <> 4
table = parse2(DemandeFichier.responseText)
With Sheets(4)
.Range("A2").Resize(UBound(table), 8) = table
End With
End Sub
Function parse2(texte As String) As Variant
Dim carccoupé As Variant, i As Long, e As Long, lignes_données As Variant, tabligne As Variant, tablo As Variant
carccoupé = Array("open", "high", "low", "close", "nymberofshares", "numoftrades", "turnover", "currency")
texte = Replace(texte, "{""data"":[", "")
texte = Replace(texte, "{""ISIN"":""FR0000120073"",""MIC"":""NYSE Euronext Paris"",""date"":""", vbCrLf)
texte = Replace(texte, "EUR""},", "")
For i = LBound(carccoupé) To UBound(carccoupé)
texte = Replace(texte, """,""" & carccoupé(i) & """:""", "#")
Next
lignes_données = Split(texte, vbCrLf)
ReDim tablo(UBound(lignes_données), 8)
For i = 1 To UBound(lignes_données)
tabligne = Split(lignes_données(i), "#")
For e = LBound(tabligne) To UBound(tabligne) - 1
tablo(i, e) = tabligne(e)
Next
Next
parse2 = tablo
End Function |
), c'est une structure que je trouve assez lourde, très verbeuse, tu peux voir cette structure dans le fichier créé par la macro.
Tutoriel : 
Répondre avec citation
: ça peut servir aux autres 
Partager