Home » excel » html – When importing data from the web, how do I get the data with links?

html – When importing data from the web, how do I get the data with links?

Posted by: admin May 14, 2020 Leave a comment

Questions:

This code (like other codes) written by Precious @QHarr works well. However, when importing data, I want to retrieve the data saved in the connection. The output of the code and the data I want to receive are shown in the attached image. What kind of code can I solve? (Google Translate)

    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("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 = 250
    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")

        Const numberOfRaces As Long = 22
        Dim counter As Long
        counter = 1
        For Each tRow In tRows
            If Not headerRow Then
                counter = counter + 1
                If counter > numberOfRaces Then Exit For
                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

Picture

How to&Answers:

You only need a few small changes. You use the same Class, clsHTTP, as before, then use the module 1 code below.


Notes:

Within each source page table row the jockey column contains an a tag link element

enter image description here

You can access this using:

tRow.getElementsByTagName("a")(1).href

As the link is relative you need to do a text replacement to add in the base part of the URL i.e.

Replace$(tRow.getElementsByTagName("a")(1).href, "about:", BASE_URL2)

The id is part of the href and can be extracted using Split:

Split(tRow.getElementsByTagName("a")(1).href, "/")(2)

To allow for these additional elements in the results you need to increase the number of output column count:

Const numTableColumns As Long = 16

And adapt your table rows loop to populate the additional columns:

results(r, 2) = Split(tRow.getElementsByTagName("a")(1).href, "/")(2) 
results(r, 3) = Replace$(tRow.getElementsByTagName("a")(1).href, "about:", BASE_URL2)

Also, adjust in the loop to ensure other columns are populated from the 4th onwards (as 2 extra columns):

c = 4

Finally, adjust your headers to include the 2 new columns:

headers = Array("Asay", "JokeyId", "JokeyLink", "Tarih", "Sehir", "K.Cinsi", "Gr", "Msf/Pist", "Derece", "S", "Jokey", "Kilo", "G.Ç", "Hnd", "Gny", "Taki")

VBA:

Module 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", "JokeyId", "JokeyLink", "Tarih", "Sehir", "K.Cinsi", "Gr", "Msf/Pist", "Derece", "S", "Jokey", "Kilo", "G.Ç", "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 = 250
    Const numTableColumns As Long = 16
    Const BASE_URL As String = "https://yenibeygir.com/at/"
    Const BASE_URL2 As String = "https://yenibeygir.com"
    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 = 4: r = r + 1
                results(r, 1) = asays(asay)
                On Error Resume Next
                results(r, 2) = Split(tRow.getElementsByTagName("a")(1).href, "/")(2)
                results(r, 3) = Replace$(tRow.getElementsByTagName("a")(1).href, "about:", BASE_URL2)
                On Error GoTo 0
                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

Sample results:

enter image description here