Почему код не получает данные с веб-страницы?

Question

Sub Yarislar()
    Dim Asays(), ws As Worksheet, Asay As Long, html As HTMLDocument
    Dim http As clsHTTP, url As String, headers(), numberOfRequests As Long
    headers = Array("Asay", "Tarih", "Sehir", "Cins", "Grup", "Msf/Pist", "Derece", "Sira", "Jokey", "Kilo", "GC", "Hnd", "Gny", "Taki")
    Set http = New clsHTTP
    Set ws = ThisWorkbook.Worksheets("X")
    Set html = New HTMLDocument
    Asays = Application.Transpose(Sheets("Y").Range("A2:A" & Sheets("Y").Columns("A:A").Find(What:="boş").Row - 1).Value)
    Const numTableRows As Long = 11
    Const numTableColumns As Long = 15
    Const BASE_URL As String = "https://yenibeygir.com/at/"
    numberOfRequests = UBound(Asays)
    Dim results(), headerRow As Boolean, tRows As Object, tRow As Object, iRow As Long
    Dim tCells As Object, tCell As Object, r As Long, c As Long, hTable As HTMLTable
    ReDim results(1 To numTableRows * numberOfRequests, 1 To numTableColumns)
    Application.ScreenUpdating = False
    For Asay = 1 To numberOfRequests
        headerRow = True
        url = BASE_URL & Asays(Asay)
        html.body.innerHTML = http.GetString(url)
        Set hTable = html.querySelector(".at_Yarislar")
        Set tRows = hTable.getElementsByTagName("tr")
        For Each tRow In tRows
            If Not headerRow Then
                c = 2: r = r + 1
                results(r, 1) = Asays(Asay)
                Set tCells = tRow.getElementsByTagName("td")
                For Each tCell In tCells
                    results(r, c) = tCell.innerText
                    c = c + 1
                Next
            End If
            headerRow = False
        Next
    Next
    With ws
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
    Application.ScreenUpdating = True
end sub

Почему код, который я изменил, @Qharr не работает для получения других данных с той же веб-страницы?Код, который @QHarr написал для данных «Galoplar», работает отлично, но когда я изменяю тот же код, он не работает для «Yarislar».Я делаю ошибку в выборе таблицы?

Ссылка

Answer 1

Вам не хватает определения класса.Вам также, я думаю, нужна другая конструкция URL.Вы не предоставили их, но, основываясь на своих предыдущих вопросах, и с небольшим воображением вам нужно добавить конструкцию URL:

BASE_URL & asay & /name

например

https://yenibeygir.com/at/10221/dorukhatun

Таким образом, столбец A на исходном листе должен иметь имена, которые должны идти с идентификаторами asay, т.е. должен содержать строки, такие как 10221/dorukhatun.

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

Вам необходимо соответствующим образом настроить диапазоны исходного столбца A.

Я использовал дваидентификаторы, которые я мог вспомнить, были в A1: A2 (обратите внимание, что некоторые результаты теперь присутствуют на листе, как и тестовый прогон)

Sheet1:

VBA:

Класс clsHTTP:

Option Explicit
Private http As Object

Private Sub Class_Initialize()
    Set http = CreateObject("MSXML2.XMLHTTP")
End Sub

Public Function GetString(ByVal url As String) As String
    Dim sResponse As String
    With http
        .Open "GET", url, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
        GetString = sResponse
    End With
End Function

Стандартный модуль 1:

Option Explicit
Public Sub DYarislar()
    Dim asays(), ws As Worksheet, asay As Long, html As HTMLDocument
    Dim http As clsHTTP, url As String, headers(), numberOfRequests As Long

    headers = Array("Asay", "Tarih", "Sehir", "K.Cinsi", "Gr", "Msf/Pist", "Derece", "S", "Jokey", "Kilo", "G.Ç", "Hnd", "Gny", "Taki")
    Set http = New clsHTTP
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set html = New HTMLDocument
    asays = Application.Transpose(ws.Range("A1:A2").Value) 'Load asay values from sheet 1

    Const numTableRows As Long = 44
    Const numTableColumns As Long = 14
    Const BASE_URL As String = "https://yenibeygir.com/at/"

    numberOfRequests = UBound(asays)

    Dim results(), headerRow As Boolean, tRows As Object, tRow As Object, iRow As Long
    Dim tCells As Object, tCell As Object, r As Long, c As Long, hTable As HTMLTable
    ReDim results(1 To numTableRows * numberOfRequests, 1 To numTableColumns)

    Application.ScreenUpdating = False

    For asay = 1 To numberOfRequests
        headerRow = True
        url = BASE_URL & asays(asay)
        html.body.innerHTML = http.GetString(url)

        Set hTable = html.querySelector(".at_Yarislar")

        Set tRows = hTable.getElementsByTagName("tr")

        For Each tRow In tRows
            If Not headerRow Then
                c = 2: r = r + 1
                results(r, 1) = asays(asay)
                Set tCells = tRow.getElementsByTagName("td")
                For Each tCell In tCells
                    results(r, c) = tCell.innerText
                    c = c + 1
                Next
            End If
            headerRow = False
        Next
    Next

    With ws
        .Cells(1, 3).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 3).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
    Application.ScreenUpdating = True
End Sub