Я хочу получить данные с веб-сайта Excel vba, но не могу

Question

Sub Galoplar()
    Sheets("Galop").Select
    Range("A1").Select
    Dim elem As Object, trow As Object
    Dim R&, C&, S$
    With New XMLHTTP60
        .Open "POST", "https://yenibeygir.com/at/getatdetaytab", False
        .setRequestHeader "content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send "tab=galopTab&id=15673"
        S = .responseText
    End With

    With New HTMLDocument
        .body.innerHTML = S

        For Each elem In .getElementsByClassName("at_Galoplar")(0).Rows
            For Each trow In elem.Cells
                C = C + 1: Cells(R + 1, C) = trow.innerText
            Next trow
            C = 0: R = R + 1
        Next elem
    End With
End Sub

Я получаю "Galopları" по ссылке " Web address " с указанным выше кодом.Но я не могу получить данные "Yarışları" с помощью следующего кода.

Sub Yarislar()
    Sheets("Yaris").Select
    Range("A1").Select
    Dim elem As Object, trow As Object
    Dim R&, C&, S$

    With New XMLHTTP60
        .Open "POST", "https://yenibeygir.com/at/getatdetaytab", False
        .setRequestHeader "content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send "tab=yarisTab&id=15673"
        S = .responseText
    End With

    With New HTMLDocument
        .body.innerHTML = S

        For Each elem In .getElementsByClassName("at_Yarislar")(0).Rows
            For Each trow In elem.Cells
                C = C + 1: Cells(R + 1, C) = trow.innerText
            Next trow
            C = 0: R = R + 1
        Next elem
    End With
End Sub

У меня вопрос о том, где я совершаю ошибку?

Как использовать код vba для получения данных "Son 1 Yıl" в " Web"адрес"ссылка?

Answer 1

На начальной целевой вкладке нет событий XHR, инициированных jquery, как на других вкладках.

Вы можете выполнить запрос GET к целевой странице, чтобы получить таблицу по имени класса для первой вкладки.

Option Explicit
Public Sub Yarislar()
    Dim s As String, html As HTMLDocument
    Set html = New HTMLDocument

    With New XMLHTTP60
        .Open "GET", "https://yenibeygir.com/at/15673/budakhan", False
        .setRequestHeader "content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send
        s = .responseText
    End With

    Dim hTable As HTMLTable, clipboard As Object
    html.body.innerHTML = s
    Set hTable = html.querySelector(".at_Yarislar")

    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    clipboard.SetText hTable.outerHTML
    clipboard.PutInClipboard
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial

End Sub

---

Для вашего второго вопроса (поскольку вы не можете его опубликовать):

Public Sub test()
    Dim s As String, html As HTMLDocument, hTable As Long, hTables As Object, clipboard As Object, ws As Object
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With New XMLHTTP60
        .Open "POST", "https://yenibeygir.com/jokey/updatestats", False
        .setRequestHeader "content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send "id=10294&LastYear=True"
        s = .responseText
    End With

    Set html = New HTMLDocument

    html.body.innerHTML = s
    Set hTables = html.querySelectorAll(".Stats")

    For hTable = 0 To hTables.Length - 1
        Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        clipboard.SetText hTables.item(hTable).outerHTML
        clipboard.PutInClipboard
        ThisWorkbook.Worksheets("Sheet1").Cells(GetLastRow(ws, 1) + 2, 1).PasteSpecial
    Next
End Sub

Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
    End With
End Function

---

Редактировать: Похоже, теперь есть проблемы со ссылкой на буфер обмена с поздней привязкойв некоторых случаях.Вот общий метод раннего связывания, где hTable является целевым объектом HTMLTable.

Для раннего связывания буфера обмена перейдите в VBE> Инструменты> Ссылки> Библиотека объектов Microsoft-Forms 2.0.

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

Dim clipboard As DataObject
Set clipboard = New DataObject
clipboard.SetText hTable.outerHTML
clipboard.PutInClipboard
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial