Moderatori: Anthony47, Flash30005
https://query1.finance.yahoo.com/v8/finance/chart/IBM
Function StockQuote(ticker As String)
'V Test
' Get near real-time stock quote from Yahoo via JSON query
Dim URL As String, response As String, stripped As String, inbits() As String, i As Long
Dim lLog As String
Dim request As WinHttp.WinHttpRequest ' needs Tools|References|WinHTTP Services
On Error GoTo Err
lLog = "A"
URL = "https://query1.financez.yahoo.com/v8/finance/chart/" & Trim(ticker)
Set request = New WinHttp.WinHttpRequest
With request
.Open "GET", URL, True
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
lLog = lLog & ".1"
.Send
lLog = lLog & ".2" & ":" & Format(Timer, "0.00:")
.WaitForResponse
lLog = lLog & ".3" & ":" & Format(Timer, "0.00:")
response = .ResponseText
End With
Debug.Print ">>>> " & ticker
Debug.Print response
Debug.Print "<<<< " & ticker
lLog = lLog & "B"
If InStr(response, """result"":[]") <> 0 Then GoTo Err ' ticker not found
'kludge parse: strip JSON delimiters and quotes
stripped = Replace(Replace(Replace(Replace(Replace(response, "[", ""), "]", ""), "{", ""), "}", ""), """", "")
stripped = Replace(stripped, ":", ":,") ' keep colons for readability, but make them delimit
inbits = Split(stripped, ",") ' split
lLog = lLog & "C"
Debug.Print "UBIn:" & UBound(inbits)
lLog = lLog & "D"
i = LBound(inbits)
Do While inbits(i) <> "regularMarketPrice:" And i <= UBound(inbits) ' find "regularMarketPrice:" tag
i = i + 1
Loop
lLog = lLog & " i=" & i
If i > UBound(inbits) Or Not IsNumeric(inbits(i + 1)) Then ' not found; look for previous close
i = LBound(inbits)
Do While inbits(i) <> "regularMarketPreviousClose:" _
And i <= UBound(inbits)
i = i + 1
Loop
If i > UBound(inbits) Or Not IsNumeric(inbits(i + 1)) Then
lLog = lLog & " i=" & i & "--" & inbits(i + 1)
GoTo Err
End If
End If
Debug.Print "lLog=" & lLog
StockQuote = Val(inbits(i + 1)) ' price is next element
Exit Function
Err:
StockQuote = CVErr(xlErrNA)
Debug.Print "ERR: " & lLog
End Function
edit: ho visto che l'indirizzo riportato nell'ultimo codice VBA ha una "z" come ultima lettera della prima parola finance (https://query1.financez.yahoo.com/v8/finance/chart/" & Trim(ticker))...
hai volutamente scritto tu così... o devo correggere?
Function StockQuote(ticker As String)
'V Test
' Get near real-time stock quote from Yahoo via JSON query
Dim URL As String, response As String, stripped As String, inbits() As String, i As Long
Dim lLog As String
Dim request As WinHttp.WinHttpRequest ' needs Tools|References|WinHTTP Services
On Error GoTo Err
lLog = "A"
URL = "https://query1.finance.yahoo.com/v8/finance/chart/" & Trim(ticker)
Debug.Print ">>>> " & URL
Set request = New WinHttp.WinHttpRequest
With request
.Open "GET", URL, True
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
lLog = lLog & ".1"
.Send
lLog = lLog & ".2" & ":" & Format(Timer, "0.00:")
.WaitForResponse
lLog = lLog & ".3" & ":" & Format(Timer, "0.00:")
response = .ResponseText
End With
Debug.Print response
Debug.Print "<<<< " & ticker
lLog = lLog & "B"
If InStr(response, """result"":[]") <> 0 Then GoTo Err ' ticker not found
'kludge parse: strip JSON delimiters and quotes
stripped = Replace(Replace(Replace(Replace(Replace(response, "[", ""), "]", ""), "{", ""), "}", ""), """", "")
stripped = Replace(stripped, ":", ":,") ' keep colons for readability, but make them delimit
inbits = Split(stripped, ",") ' split
lLog = lLog & "C"
Debug.Print "UBIn:" & UBound(inbits)
lLog = lLog & "D"
i = LBound(inbits)
Do While inbits(i) <> "regularMarketPrice:" And i <= UBound(inbits) ' find "regularMarketPrice:" tag
i = i + 1
Loop
lLog = lLog & " i=" & i
If i > UBound(inbits) Or Not IsNumeric(inbits(i + 1)) Then ' not found; look for previous close
i = LBound(inbits)
Do While inbits(i) <> "regularMarketPreviousClose:" _
And i <= UBound(inbits)
i = i + 1
Loop
If i > UBound(inbits) Or Not IsNumeric(inbits(i + 1)) Then
lLog = lLog & " i=" & i & "--" & inbits(i + 1)
GoTo Err
End If
End If
Debug.Print "lLog=" & lLog
StockQuote = Val(inbits(i + 1)) ' price is next element
Exit Function
Err:
StockQuote = CVErr(xlErrNA)
Debug.Print "ERR: " & lLog
End Function
?request.ResponseText
Application.Wait (Now + TimeValue("0:00:01"))
?request.ResponseText
{"chart":{"result":[{"meta":{"currency":"USD","symbol":"IBM","exchangeName":"NYQ","fullExchangeName":"NYSE","instrumentType":"EQUITY","firstTradeDate":-252322200,"regularMarketTime":1736888402,"hasPrePostMarketData":true,"gmtoffset":-18000,"timezone":"EST","exchangeTimezoneName":"America/New_York","regularMarketPrice":217.75,"fiftyTwoWeekHigh":239.35,"fiftyTwoWeekLow":162.62,"regularMarketDayHigh":218.125,"regularMarketDayLow":214.69,"regularMarketVolume":2690859,"longName":"International Business Machines Corporation","shortName":"International Business Machines","chartPreviousClose":217.4,"previousClose":217.4,"scale":3,"priceHint":2,"currentTradingPeriod":{"pre":{"timezone":"EST","end":1736951400,"start":1736931600,"gmtoffset":-18000},"regular":{"timezone":"EST","end":1736974800,"start":1736951400,"gmtoffset":-18000},"post":{"timezone":"EST","end":1736989200,"start":1736974800,"gmtoffset":-18000}},"tradingPeriods":[[{"timezone":"EST","end":1736888400,"start":1736865000,"gmtoffset":-18000}]],"dataGranulari
ty":"1m","range":"1d","validRanges":["1d","5d","1mo","3mo","6mo","1y","2y","5y","10y","ytd","max"]},"timestamp":[1736865000,1736865060,1736865120,1736865180,1736865240,1736865300,1736865360,1736865420,1736865480,1736865540,1736865600,1736865660,1736865720,1736865780,1736865840,1736865900,1736865960,1736866020,1736866080,1736866140,1736866200,1736866260,1736866320,1736866380,1736866440,1736866500,1736866560,1736866620,1736866680,1736866740,1736866800,1736866860,1736866920,1736866980,1736867040,1736867100,1736867160,1736867220,1736867280,1736867340,1736867400,1736867460,1736867520,1736867580,1736867640,1736867700,1736867760,1736867820,1736867880,1736867940,1736868000,1736868060,1736868120,1736868180,1736868240,1736868300,1736868360,1736868420,1736868480,1736868540,1736868600,1736868660,17 etc etc
Function GimmeQuote(ByVal Ticker As String) As Variant
Dim URL As String, Pos1 As Long, nLFor As String
Dim XMLObj As Object
'
Set XMLObj = CreateObject("msxml2.xmlhttp")
'
URL = "https://query1.finance.yahoo.com/v8/finance/chart/" & Trim(Ticker)
With XMLObj
.Open "GET", URL, False
.Send
rtxt = .ResponseText
End With
nLFor = "regularMarketPrice"
Pos1 = InStr(1, rtxt, nLFor, vbTextCompare)
If Pos1 > 0 Then
GimmeQuote = CSng(Replace(Split(Mid(rtxt, Pos1 + Len(nLFor) + 2, 50) & "..:::,..", ",", , vbTextCompare)(0), ".", ",", , , vbTextCompare))
Else
GimmeQuote = CVErr(xlErrNA)
End If
End Function
=GimmeQuote("IBM")
=GimmeQuote(A2)
Eh, l'avessi saputo te l'avrei già fatto controllare... Ma questi sono servizi erogati dal sistema operativoIn merito alla tua prima ipotesi - "la libreria WINHTTPCOM.dll o non e' installata correttamente o non e' disponibile (per limitazione di sicurezza) a tutti gli utenti - come posso fare per verificare tale supposizione?
System32 e SysWOW64 sono contenitori per software di sistema a 32 bit o a 64 bit. Non ho idea se avendo anche tu (immagino) Window a 64bit la dll debba essere in un percorso o in un altro; io ce l'ho in ambedue (1.73MByte in SysWow64 e 2.23 MB in System32) ma non so quale effettivamente e' in usoin merito alla libreria MSXML6.dll (che non era selezionata/spuntata), ho visto che ha questo percorso:
C:\Windows\SysWOW64\msxml6.dll anzichè C:\WINDOWS\system32\
può essere una motivazione?
La mia situazione e' analoga a questa...brtbrn ha scritto:la MSXML6.dll è presente in SysWOW64 nella versione 6.30.26100.2454 con dimensione 1,73 MB
la MSXML6.dll è presente in System32 nella versione 6.30.26100.2454 con dimensione 2,23 MB
Torna a Applicazioni Office Windows
Licenze online windows ed office. Cosa buona?... Autore: nippon |
Forum: Sistemi Operativi Windows Risposte: 5 |
SOMMARE DUE VALORI IN DUE COLONNE DIVERSE Autore: millennia80 |
Forum: Applicazioni Office Windows Risposte: 1 |
Visitano il forum: Nessuno e 19 ospiti