Здравствуйте. Пишу простой парсер курса крипты. Часть кода нашёл на каком то сайте, осталось доработать. Нужно чтобы код исполнялся каждые несколько секунд для постоянного обновления цен. Подскажите как это сделать. В программировании совсем не разбираюсь.
[vba]
Код
Private Sub Workbook_Open()
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "GET", "https://api.binance.com/api/v3/ticker/price?symbol=BTCUSDT", False XMLHTTP.Send If XMLHTTP.statustext = "OK" Then txt = XMLHTTP.responseText txt = Replace(txt, "{""symbol"":""BTCUSDT"",""price"":""", "") txt = Replace(txt, """}", "") Cells(2, 3) = txt End If XMLHTTP.abort Set XMLHTTP = Nothing
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "GET", "https://api.binance.com/api/v3/ticker/price?symbol=TUSDUSDT", False XMLHTTP.Send If XMLHTTP.statustext = "OK" Then txt = XMLHTTP.responseText txt = Replace(txt, "{""symbol"":""TUSDUSDT"",""price"":""", "") txt = Replace(txt, """}", "") Cells(4, 3) = txt End If XMLHTTP.abort Set XMLHTTP = Nothing
End Sub
[/vba]
Здравствуйте. Пишу простой парсер курса крипты. Часть кода нашёл на каком то сайте, осталось доработать. Нужно чтобы код исполнялся каждые несколько секунд для постоянного обновления цен. Подскажите как это сделать. В программировании совсем не разбираюсь.
[vba]
Код
Private Sub Workbook_Open()
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "GET", "https://api.binance.com/api/v3/ticker/price?symbol=BTCUSDT", False XMLHTTP.Send If XMLHTTP.statustext = "OK" Then txt = XMLHTTP.responseText txt = Replace(txt, "{""symbol"":""BTCUSDT"",""price"":""", "") txt = Replace(txt, """}", "") Cells(2, 3) = txt End If XMLHTTP.abort Set XMLHTTP = Nothing
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "GET", "https://api.binance.com/api/v3/ticker/price?symbol=TUSDUSDT", False XMLHTTP.Send If XMLHTTP.statustext = "OK" Then txt = XMLHTTP.responseText txt = Replace(txt, "{""symbol"":""TUSDUSDT"",""price"":""", "") txt = Replace(txt, """}", "") Cells(4, 3) = txt End If XMLHTTP.abort Set XMLHTTP = Nothing
Private Sub Workbook_Open() Call u_498 End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Call u_499 End Sub
[/vba] стандартный: [vba]
Код
Sub u_498() x = Now + TimeSerial(0, 0, 10) '10 секунд Application.OnTime x, "u_498" Call u_500 End Sub Sub u_499() On Error Resume Next Application.OnTime EarliestTime:=x, Procedure:="u_498", Schedule:=False End Sub Sub u_500() Set XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "GET", "https://api.binance.com/api/v3/ticker/price?symbol=BTCUSDT", False XMLHTTP.Send If XMLHTTP.statustext = "OK" Then txt = XMLHTTP.responseText txt = Replace(txt, "{""symbol"":""BTCUSDT"",""price"":""", "") txt = Replace(txt, """}", "") Cells(2, 3) = txt End If XMLHTTP.abort Set XMLHTTP = Nothing
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "GET", "https://api.binance.com/api/v3/ticker/price?symbol=TUSDUSDT", False XMLHTTP.Send If XMLHTTP.statustext = "OK" Then txt = XMLHTTP.responseText txt = Replace(txt, "{""symbol"":""TUSDUSDT"",""price"":""", "") txt = Replace(txt, """}", "") Cells(4, 3) = txt End If XMLHTTP.abort Set XMLHTTP = Nothing End Sub
[/vba]
модуль книги: [vba]
Код
Private Sub Workbook_Open() Call u_498 End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Call u_499 End Sub
[/vba] стандартный: [vba]
Код
Sub u_498() x = Now + TimeSerial(0, 0, 10) '10 секунд Application.OnTime x, "u_498" Call u_500 End Sub Sub u_499() On Error Resume Next Application.OnTime EarliestTime:=x, Procedure:="u_498", Schedule:=False End Sub Sub u_500() Set XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "GET", "https://api.binance.com/api/v3/ticker/price?symbol=BTCUSDT", False XMLHTTP.Send If XMLHTTP.statustext = "OK" Then txt = XMLHTTP.responseText txt = Replace(txt, "{""symbol"":""BTCUSDT"",""price"":""", "") txt = Replace(txt, """}", "") Cells(2, 3) = txt End If XMLHTTP.abort Set XMLHTTP = Nothing
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "GET", "https://api.binance.com/api/v3/ticker/price?symbol=TUSDUSDT", False XMLHTTP.Send If XMLHTTP.statustext = "OK" Then txt = XMLHTTP.responseText txt = Replace(txt, "{""symbol"":""TUSDUSDT"",""price"":""", "") txt = Replace(txt, """}", "") Cells(4, 3) = txt End If XMLHTTP.abort Set XMLHTTP = Nothing End Sub