#excel #xml #vba #web #url
#преуспеть #xml #vba #паутина #url-адрес
Вопрос:
В разделе Excel, как мне получить фактический текст URL-адреса вместо текста HREF для элемента (1) внизу? Я использую XML, но все остальное приемлемо, если это позволяет выполнить работу.
обновление: спасибо Zwenn за приведенное ниже решение.
Sub GetDogRace2()
Const URL2 = "https://fasttrack.grv.org.au/RaceField/ViewRaces/-83280?raceId=0"
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim obj As HTMLHtmlElement
Dim obj2 As HTMLHtmlElement
Range("C1:I500") = ""
With http
.Open "GET", URL2, False
.send
html.body.innerHTML = .responseText
End With
x = 2
For Each obj2 In html.getElementsByClassName("race-results-content")
For Each obj In html.getElementsByTagName("tr")
With obj.getElementsByTagName("td")
If .Length Then Cells(x, 9) = Trim(Replace(.Item(1).innerHTML, " ", "")) '<-ThisOne
End With
x = x 1
Next obj
Next obj2
Set http = Nothing: Set html = Nothing: Set obj2 = Nothing: Set obj = Nothing
End Sub
Ответ №1:
Вам нужен a-тег внутри td-тега. Затем вы можете получить URL-адрес с помощью .href
.
Sub GetDogRace2()
Const URL2 = "https://fasttrack.grv.org.au/RaceField/ViewRaces/-83280?raceId=0"
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim nodeRaceResultsTable As HTMLHtmlElement
Dim nodeTr As HTMLHtmlElement
Dim currentUrl As String
Dim currentRow As Long
currentRow = 2
Range("C1:I500") = ""
With http
.Open "GET", URL2, False
.send
html.body.innerHTML = .responseText
End With
For Each nodeRaceResultsTable In html.getElementsByClassName("raceResultsTable")
For Each nodeTr In nodeRaceResultsTable.getElementsByTagName("tr")
With nodeTr.getElementsByTagName("td")
If .Length Then
currentUrl = .Item(1).getElementsByTagName("a")(0).href 'Get a-tag in td
currentUrl = Replace(currentUrl, "about:", "https://fasttrack.grv.org.au") 'Edit url
ActiveSheet.Hyperlinks.Add Anchor:=Cells(currentRow, 9), Address:=currentUrl, TextToDisplay:=currentUrl 'place url as link
Cells(currentRow, 10) = .Item(1).innerText 'You can also use innerText for TextToDisplay:, in the hyperlink to place
currentRow = currentRow 1
End If
End With
Next nodeTr
Next nodeRaceResultsTable
End Sub