Блог

Я хочу получить цены на криптовалюты от Binance в excel и зарегистрировать их. Приведенный ниже код отлично работает в Windows, но на Mac он выдает ошибку 429 во время выполнения «Компонент ActiveX не может создать объект».

 Sub GetData()

Dim objHTTP As Object, strURL As String, HTMLcode As String
Dim arrProperties()
Dim arrPattern(1 To 21) As String
Dim regExp As Object, xPattern As Variant
Dim r As Integer, c As Byte
Dim strResponse As String, intStatus As Integer, strStatus As String

Range("A1:U" amp; Rows.Count) = ""

arrProperties = Array("symbol", "priceChange", "priceChangePercent", "weightedAvgPrice", "prevClosePrice", _
                      "lastPrice", "lastQty", "bidPrice", "bidQty", "askPrice", "askQty", "openPrice", _
                      "highPrice", "lowPrice", "volume", "quoteVolume", "openTime", "closeTime", _
                      "firstId", "lastId", "count")
                      
Range("A1:U1") = arrProperties
Range("A1:U1").Font.Bold = True
Range("A1:U1").Font.Color = vbRed

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

strURL = "https://api.binance.com/api/v3/ticker/24hr"

objHTTP.Open "GET", strURL, False
objHTTP.send

If objHTTP.ReadyState = 4 And objHTTP.Status = 200 Then
    HTMLcode = objHTTP.responseText
    
    arrPattern(1) = """symbol"":""(. ?)"",""priceChange"":"
    arrPattern(2) = """priceChange"":""(. ?)"",""priceChangePercent"":"
    arrPattern(3) = """priceChangePercent"":""(. ?)"",""weightedAvgPrice"":"
    arrPattern(4) = """weightedAvgPrice"":""(. ?)"",""prevClosePrice"":"
    arrPattern(5) = """prevClosePrice"":""(. ?)"",""lastPrice"":"
    arrPattern(6) = """lastPrice"":""(. ?)"",""lastQty"":"
    arrPattern(7) = """lastQty"":""(. ?)"",""bidPrice"":"
    arrPattern(8) = """bidPrice"":""(. ?)"",""bidQty"":"
    arrPattern(9) = """bidQty"":""(. ?)"",""askPrice"":"
    arrPattern(10) = """askPrice"":""(. ?)"",""askQty"":"
    arrPattern(11) = """askQty"":""(. ?)"",""openPrice"":"
    arrPattern(12) = """openPrice"":""(. ?)"",""highPrice"":"
    arrPattern(13) = """highPrice"":""(. ?)"",""lowPrice"":"
    arrPattern(14) = """lowPrice"":""(. ?)"",""volume"":"
    arrPattern(15) = """volume"":""(. ?)"",""quoteVolume"":"
    arrPattern(16) = """quoteVolume"":""(. ?)"",""openTime"":"
    arrPattern(17) = """openTime"":(. ?),""closeTime"":"
    arrPattern(18) = """closeTime"":(. ?),""firstId"":"
    arrPattern(19) = """firstId"":(. ?),""lastId"":"
    arrPattern(20) = """lastId"":(. ?),""count"":"
    arrPattern(21) = """count"":(. ?)}"
    
    Set regExp = CreateObject("VBScript.RegExp")
    
    regExp.ignorecase = True
    regExp.Global = True
        
    For Each xPattern In arrPattern
        regExp.Pattern = xPattern
        r = 1
        c = c   1
        If regExp.test(HTMLcode) Then
            For Each retVal In regExp.Execute(HTMLcode)
                r = r   1
                Cells(r, c) = retVal.Submatches(0)
            Next
        End If
    Next
    
    Columns("A:U").AutoFit
    MsgBox "›˛lem tamam...", vbInformation
Else
    strResponse = Split(objHTTP.responseText, "status"":")(1)
    intStatus = Split(strResponse, "}")(0)   0
    
    strResponse = Split(objHTTP.responseText, "error"":""")(1)
    strStatus = Split(strResponse, """")(0)
    
    MsgBox "Durum: " amp; intStatus amp; vbCrLf amp; vbCrLf amp; "Hata mesaj˝: " amp; strStatus
End If

Set regExp = Nothing
Set objHTTP = Nothing
Erase arrPattern
 

Конец Суб

Я нахожу некоторые ответы с помощью Dictioanry.cls и KeyValuePair.cls, но это не работает для меня. Есть ли какой-либо способ исправить эту ошибку на VBA