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
| '16.5d LECTURE DE DEVISES AU FORMAT JSON
Public Sub MajDevises
Dim http As MSXML2.ServerXMLHTTP, Liste As String, rado As New ADODB.Recordset, nb As Integer, i As Long, s As String
100 nb = 0 'nombre de devises mises à jour
102 Liste = ""
'Lecture du flux
If Not Mode_debug Then On Error GoTo suite
105 Set http = New MSXML2.ServerXMLHTTP
'106 http.Open "GET", "http://api.fixer.io/latest", False
106 http.Open "GET", "http://www.floatrates.com/daily/eur.json", False '18.6 changement de service (le précédent nécessite une inscription)
107 http.send ""
'En cas de réussite, le code renvoyé est 200
110 If http.Status <> 200 Then
112 Liste = ""
113 If bilan Then MsgBox "Erreur en lecture de devises code " & http.Status
Exit Sub
Else
115 Liste = http.responseText
End If
116 Set http = Nothing
'MsgBox Liste
'{"code":"USD","alphaCode":"USD","numericCode":"840","name":"U.S. Dollar","rate":1.1652270771017,"date":"Thu, 5 Jul 2018 00:00:01 GMT","inverseRate":0.73651036638205},"gbp":{"code":"GBP","alphaCode":"GBP","numericCode":"826","name":"U.K. Pound Sterling","rate":0.88154654761594,"date":"Thu, 5 Jul 2018 00:00:01 GMT","inverseRate":0.97351844187397},"jpy":{"code":"JPY","alphaCode":"JPY","numericCode":"392","name":"Japanese Yen","rate":128.81482993197...
suite:
If Not Mode_debug Then On Error GoTo err 'Pour info ma gestion d'erreur standard nécessite de numéroter les lignes comme au 20e siècle !
120 If Liste > "" Then
122 rado.Open "SELECT * FROM devises WHERE code3<>'EUR' order by code3;", cnx, adOpenStatic
124 While Not rado.EOF
126 i = InStr(Liste, """" & rado!code3 & """:")
128 If i > 0 Then
129 While i < 30000 And Mid(Liste, i, 7) <> """rate"":"
i = i + 1
Wend
130 If Mid(Liste, i, 7) = """rate"":" Then
131 s = Mid(Liste, i + 7, 12)
132 If InStr(s, ",") > 1 Then s = Left(s, InStr(s, ",") - 1) 'ne prend que le texte avant la virgule
133 s = Replace(s, ".", ",")
134 If IsNumeric(s) And s > "0" Then
136 currentDB.Execute "UPDATE devises SET taux=" & Num(1 / s, 6) & ", Dmodif=date() WHERE code3='" & rado!code3 & "'", dbfailonerror
138 nb = nb + 1
End If: End If: End If
140 rado.MoveNext
Wend
End If
Set rado = Nothing
Exit Sub
err: Call message("Erreur " & err.Number & "/" & Erl & " dans api_stock.MajDevises(statut " & nb & ") : " & err.description)
End Sub |
Partager