Excel VBA - Web Scraping - Texto interno da célula da tabela HTML

Question

Estou tentando criar uma macro para rastrear na web o status de uma Remessa de Carga com base no número da remessa. Estou usando o método XML-HTTP, mas sou novo no VBA web scraping. Tentei obter o valor usando GetValuebyID, Tag, Class sem sucesso.

A linha destacada é aquela da qual preciso extrair o valor. [Necessidade de extrair 10 de 10 valores entregues] [1]

Foi até onde cheguei com o código.

Sub FlightStat()

Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim AllTables As IHTMLElementCollection
Dim MainTable As IHTMLTable


XMLReq.Open "GET", "https://www.unitedcargo.com/OurNetwork/TrackingCargo1512/Tracking.jsp?id=10205436&pfx=016", False

XMLReq.send

If XMLReq.Status <> 200 Then
    MsgBox "Problem" & vbNewLine & XMLReq.Status & " - " & XMLReq.statusText
    Exit Sub
End If

HTMLDoc.body.innerHTML = XMLReq.responseText

Set AllTables = HTMLDoc.getElementsByTagID("dispTable0")

  

End Sub

Eu ficaria muito grato se alguém pudesse me ajudar a extrair o valor "10 de 10 entregues" [1]: https://i.stack.imgur.com/xcOAZ.png

Answer 1

Ok, como escrevi no meu comentário. Você pode raspar o status com o IE.

Observação: o código a seguir não tem tempo limite embutido se o conteúdo dinâmico não pode ser carregado. Também não há verificação se o número passado na URL está correto.

Sub FlightStat()

Dim url As String
Dim ie As Object
Dim nodeTable As Object

  'You can handle the parameters id and pfx in a loop to scrape dynamic numbers
  url = "https://www.unitedcargo.com/OurNetwork/TrackingCargo1512/Tracking.jsp?id=10205436&pfx=016"

  'Initialize Internet Explorer, set visibility,
  'call URL and wait until page is fully loaded
  Set ie = CreateObject("InternetExplorer.Application")
  ie.Visible = False
  ie.navigate url
  Do Until ie.readyState = 4: DoEvents: Loop
  
  'Wait to load dynamic content after IE reports it's ready
  'We can do that in a loop to match the point the information is available
  Do
    On Error Resume Next
    Set nodeTable = ie.document.getElementByID("dispTable0")
    On Error GoTo 0
  Loop Until Not nodeTable Is Nothing
  
  'Get the status from the table
  MsgBox Trim(nodeTable.getElementsByTagName("li")(2).innertext)
  
  'Clean up
  ie.Quit
  Set ie = Nothing
  Set nodeTable = Nothing
End Sub