Парсер цены. - Мир MS Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Парсер цены. (Макросы/Sub)

Парсер цены.

qwertyu

Дата: Вторник, 13.02.2024, 17:48 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Здравствуйте.
Пишу простой парсер курса крипты. Часть кода нашёл на каком то сайте, осталось доработать.
Нужно чтобы код исполнялся каждые несколько секунд для постоянного обновления цен.
Подскажите как это сделать. В программировании совсем не разбираюсь.

[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]

Ответить

Nic70y

Дата: Четверг, 15.02.2024, 08:37 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 8761

Репутация: 2273 ±

Замечаний: 0% ±

Excel 2010

модуль книги:
[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

[/vba]