我似乎无法从使用 excel 中的 VBA 不断更改价格的网站上抓取数据

Question

我检查网站的来源时似乎找不到 ID "rofex.primary.ventures"。我想要做的就是获取 Ult 列下方的所有数据并将其放入 excel 工作表中。我使用 firefox，因为它以更好的方式显示 HTLM 代码，但我想使用 excel 宏从 chrome 中抓取它。我该怎么做？

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

这就是我所拥有的，但出现了所有类型的错误，我是编码新手，不用说。谢谢！

Answer 1

使用可用的API。有一个 csv 格式的 xmlhttp 响应，您可以将其作为提取此信息的目标。请注意，结果以 1000 为单位，因此，例如，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 as 然后使用循环列 A 并使用拆分来提取感兴趣的列。下载部分如下所示。

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

我似乎无法从使用 excel 中的 VBA 不断更改价格的网站上抓取数据

I cant seem able to scrape data form a website that is constantly changing its prices using VBA in excel

html

excel

vba

web-scraping

scrape