Мой код ниже работал нормально, но по какой-то причине я получаю "Not Found" результаты в Excel. Если я скопирую URL-адрес и добавлю любой символ акции, например, AAPL, он будет работать, но от VBA я не получаю результатов.
Option Explicit
Public Sub GetClosePrices()
Dim lastRow As Long, url As String, ws As Worksheet, tickers(), dateString As String
Set ws = ThisWorkbook.Worksheets("Historical")
With ws
dateString = Format$(.Range("A1").Value, "yyyy-mm-dd")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If lastRow >= 2 Then
.Range("K3:K" & lastRow).ClearContents
tickers = Application.Transpose(.Range("A3:A" & lastRow).Value)
Else
Exit Sub
End If
End With
Dim s As String, re As Object, p As String, r As String, prices(), i As Long
ReDim prices(1 To UBound(tickers))
p = """DATE_HERE"",""open"":[0-9.]+,""close"":(.*?)," 'Format must be YYYY-MM-DD
p = Replace$(p, "DATE_HERE", dateString)
url = "https://cloud.iexapis.com/stable/stock/TICKER_HERE/chart/1m?token=pk_f4e3ce4594124d8186d29dbcb40a1ac5" 'email change for new code info and gmail.
Set re = CreateObject("VBScript.RegExp")
With CreateObject("MSXML2.XMLHTTP")
For i = LBound(tickers) To UBound(tickers)
.Open "GET", Replace$(url, "TICKER_HERE", tickers(i)), False
.SetRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.Send
If .Status = 200 Then
s = .ResponseText
r = GetValue(re, s, p)
Else
r = "Failed connection"
End If
prices(i) = r
Next
End With
ws.Cells(3, "K").Resize(UBound(prices), 1) = Application.Transpose(prices)
End Sub
Public Function GetValue(ByVal re As Object, ByVal inputString As String, ByVal pattern As String) As String
With re
.Global = True
.pattern = pattern
If .test(inputString) Then ' returns True if the regex pattern can be matched agaist the provided string
GetValue = .Execute(inputString)(0).submatches(0)
Else
GetValue = "Not found"
End If
End With
End Function
Пожалуйста, проверьте, что вызывает этот вывод.