I want to get data from web site with Excel vba bu

2019-08-12 15:20发布

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

I get "Galopları" from the "Web address" link with the above code. But I can't get "Yarışları" data with the following code.

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

My question is about, where am I making a mistake?

How do I use a vba code to get the "Son 1 Yıl" data on the "Web address" link?

1条回答
仙女界的扛把子
2楼-- · 2019-08-12 15:53

The initial landing tab does not have jquery initiated XHR events which the other tabs do.

You can issue a GET request against your landing page to grab the table by its class name for the first tab.

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

For your second question (as you are unable to post it):

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

Edit: There now seems to be problems with late bound clipboard reference in some cases. Here is generic early bound method where hTable is the target HTMLTable object.

For clipboard early bound go VBE > Tools > References > Microsoft-Forms 2.0 Object Library.

If you add a UserForm to your project, the library will get automatically added.

Dim clipboard As DataObject
Set clipboard = New DataObject
clipboard.SetText hTable.outerHTML
clipboard.PutInClipboard
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
查看更多
登录 后发表回答