Кажется, я не могу собрать данные с веб-сайта, который постоянно меняет цены, используя VBA в Excel. - PullRequest
Новая
       37

Кажется, я не могу собрать данные с веб-сайта, который постоянно меняет цены, используя VBA в Excel.

0 голосов
/ 23 января 2019

Не могу найти идентификатор, когда проверяю источник на сайте "rofex.primary.ventures". Все, что я хочу сделать, это взять все данные под столбцом Ult и поместить их в таблицу Excel. Я использовал Firefox, потому что он показывает код HTLM лучше, но я хотел бы очистить его от Chrome с помощью Excel Macro. Как бы я это сделал? 

Sub Rofex()

Dim appIE As Object
Set appIE = CreateObject("internetexplorer.application")
With appIE
.Navigate "https://rofex.primary.ventures"
.Visible = True
End With
Do While appIE.Busy
DoEvents
Loop

Set allRowOfData = appIE.document.getElementById("rx:DO:2019:01:a")
Dim myValue As String: myValue = allRowOfData.Cells(6).innerHTML

appIE.Quit
Set appIE = Nothing
Range("A1").Value = myValue
End Sub

Это то, что у меня есть, но я получаю все типы ошибок, я новичок в кодировании, разумеется. Спасибо!

1 Ответ

0 голосов
/ 23 января 2019

Используйте доступный API.Существует ответ xmlhttp в формате csv, который можно использовать для извлечения этой информации.Обратите внимание, что результаты представлены в тысячах, поэтому, например, DOEne19 равно ult 37,960, а результат равен 37.96.

Option Explicit

Public Sub GetInfo()
    Const URL As String = "https://rofex.primary.ventures/api/v1/platform/market/md"
    Dim lines() As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        lines = Split(.responseText, vbLf)
    End With
    Dim output(), i As Long, rowCounter As Long, arr() As String
    ReDim output(1 To UBound(lines), 1 To 2)
    For i = 1 To UBound(lines)
        If InStr(lines(i), "|") > 0 Then
            rowCounter = rowCounter + 1
            arr = Split(lines(i), "|")
            output(rowCounter, 1) = Replace$(arr(0), "m;", vbNullString)
            output(rowCounter, 2) = arr(6)
        End If
    Next
    output = Application.Transpose(output)
    ReDim Preserve output(1 To 2, 1 To rowCounter)
    output = Application.Transpose(output)

    With ThisWorkbook.Worksheets("Sheet1")
        .Cells(1, 1) = "Ticker": .Cells(1, 2) = "1000s"
        .Cells(2, 1).Resize(UBound(output, 1), UBound(output, 2)) = output
    End With
End Sub

В противном случае вы можете скачать как csv, а затем использовать столбец цикла A и использовать split для извлечения интересующих столбцов.Загрузите часть, показанную ниже. 

Public Sub DownloadFile()
    Dim http As Object
    Const filepath As String = "C:\Users\User\Desktop\TestDownload.csv"
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://rofex.primary.ventures/api/v1/platform/market/md", False
    http.send
    On Error GoTo errhand
    With CreateObject("ADODB.Stream")
        .Open
        .Type = 1
        .Write http.responseBody
        .SaveToFile filepath '<== specify your path here
        .Close
    End With
    Debug.Print "FileDownloaded"
    TidyFile filepath
    Exit Sub
errhand:
    If Err.Number <> 0 Then
        Debug.Print Err.Number, Err.Description
        MsgBox "Download failed"
    End If
End Sub

Public Sub TidyFile(ByVal filepath As String)
    Dim wb As Workbook, lines(), i As Long, output(), rowCounter As Long, arr() As String
    Set wb = Workbooks.Open(filepath)

    With wb.Sheets(1)
        lines = Application.Transpose(.Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value)

        ReDim output(1 To UBound(lines), 1 To 2)
        For i = LBound(lines) To UBound(lines)
            If InStr(lines(i), "|") > 0 Then
                rowCounter = rowCounter + 1
                arr = Split(lines(i), "|")
                output(rowCounter, 1) = Replace$(arr(0), "m;", vbNullString)
                output(rowCounter, 2) = arr(6)
            End If
        Next
        output = Application.Transpose(output)
        ReDim Preserve output(1 To 2, 1 To rowCounter)
        output = Application.Transpose(output)
        .Cells.ClearContents
        .Cells(1, 1) = "Ticker": .Cells(1, 2) = "1000s"
        .Cells(2, 1).Resize(UBound(output, 1), UBound(output, 2)) = output
    End With
    wb.Close SaveChanges:=True
End Sub
...