代码为什么不从网页接收数据? [英] Why doesn't the code receive data from the web page?

问题描述

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"不起作用.我在选择表格时会犯错误吗?

Why is the code I modified @Qharr not working to retrieve other data from the same web page? The code that @QHarr wrote for the "Galoplar" data works perfectly, but when I modify the same code, it doesn't work for "Yarislar". Do I make a mistake in table selection?

链接

推荐答案

您缺少类定义.我认为您还需要其他URL构造.您尚未提供问题，但基于先前的问题，并且有一点想像力，您需要添加以下URL构造:

You are missing the class definition. You also, I think, need a different URL construction. You haven't provided ones but based on your prior questions, and with a little imagination, you need to add a URL construction of:

BASE_URL & asay & /name

例如

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

因此，源工作表中的A列必须具有与asay ID对应的名称，即，必须包含诸如10221/dorukhatun之类的字符串.

So, column A in source sheet must have the names to go with the asay ids i.e. must contain strings such as 10221/dorukhatun.

然后，您还必须调整用于控制表中行号和列号的常量.

You must then also adjust the constants governing row numbers and column numbers in tables.

您将需要适当调整源列A的范围.

You will need to adjust the source column A ranges appropriately.

我使用了我记得的两个ID，并在A1:A2中添加了以下内容(请注意，某些结果现在已经在试运行中显示在工作表中)

I used the two ids I could remember and had the following in A1:A2 (note some results are now present in sheet as have test run)

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

这篇关于代码为什么不从网页接收数据?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！