Вопросы для извлечения URL с веб-сайта с помощью sub для Excel

#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