跨度 id 值没有用 excel VBA 刮掉

Question

我有一个 Excel 代码，它从 nowgoal.com 抓取匹配结果，尽管 nowgoal 页面结构没有变化，但该代码最近停止工作

单元格 AF2 包含“1”，用于控制应抓取哪些行数据（基本上，在 A 列中添加数字 1 的每一行都应进行抓取处理）。

每行包含 nowgoal ID（http://www.nowgoal.com/analysis/1401651.html - ID 为 1401651），并且应将主场目标刮到 C 列，将客场目标刮到每一行的 D 列）

这是我的代码：

Option Explicit
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Sub GetResult()

Const START_ROW As Integer = 3
Const START_COL As Integer = 3

Const ANALYSIS_PAGE As String = "http://www.nowgoal.com/analysis/"

Dim LString As String, LArray() As String

'get week number
Dim week As Integer: week = ActiveSheet.Cells(2, 32)

'instantiate worksheet to process
Dim wks As Worksheet: Set wks = ActiveSheet

'instantiate browser
Dim ie As New InternetExplorer
ie.Visible = True

'instantiate variables
Dim url As String, i As Integer, j As Integer
Dim nowGoalID As Long, iRow As Long, lastRow As Long

With wks

    lastRow = .Cells(Rows.Count, 1).End(xlUp).Row

    For iRow = START_ROW To lastRow

        'check week
        If .Cells(iRow, 1) <> week Or .Cells(iRow, 2) = "" Then GoTo nextRow
        Application.Goto .Cells(iRow, 1), True
        DoEvents

        nowGoalID = .Cells(iRow, 2)
        Application.StatusBar = "Processing row: " & iRow & " " & nowGoalID

        url = ANALYSIS_PAGE & nowGoalID & ".html"

        ie.navigate url
        While ie.Busy: DoEvents: Sleep 100: Wend
        While ie.readyState <> READYSTATE_COMPLETE: DoEvents: Sleep 100: Wend

        LString = Mid(ie.document.getElementById("mScore").innerText, 8)
        LArray = Split(LString, "-")

        Cells(70, 2).Value = LArray

nextRow:
Next iRow
End With

ie.Quit
Set ie = Nothing
MsgBox "All done", vbInformation
End Sub

宏打开 IE 并找到正确的网站，但没有完成抓取

Answer 1

我认为您可以将 id 连接到 ajax xhr

Option Explicit    
Public Sub GetScores()
    Dim arr() As String, ws As Worksheet, ids(), id As Long
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ids = Array(1692803, 1401651)

    With CreateObject("MSXML2.XMLHTTP")
        For id = LBound(ids) To UBound(ids)
            .Open "GET", "http://www.nowgoal.com/Ajax.aspx?type=24&id=" & ids(id) & "&p=1553884659000", False
            .send
            If .Status = 200 Then
                arr = Split(.responseText, "-")
                ws.Cells(id + 1, "C") = arr(0): ws.Cells(id + 1, "D") = arr(1)
            End If
        Next
    End With
End Sub