Excel VBA - Web Kazıma - HTML Tablo hücresinde değer elde edin

Question

Kargo takip web sitesini çizen bir makro oluşturmaya çalışıyorum. Ancak her havayolunun farklı bir web sitesi olduğu için bu tür 4 makro oluşturmam gerekiyor.

VBA ve web kazıma konusunda yeniyim.

1 web sitesi için çalışan bir kod oluşturdum. Ama onu başka biri için kopyalamaya çalıştığımda, döngüde sıkışıp kaldım. Öğeden nasıl bahsettiğimi düşünüyorum, ama dediğim gibi, VBA'da yeniyim ve HTML hakkında hiçbir fikrim yok.

Görüntüden vurgulanan satırdaki "bildirilen" değeri almaya çalışıyorum.

GÖRÜNTÜ: Çıkarılacak "bildirilen" metin Aşağıda şimdiye kadar yazdığım döngüde sıkışmış kod var. Bununla ilgili herhangi bir yardım memnuniyetle karşılanacaktır.

Sub FlightStat_AF()

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.afklcargo.com/mycargo/shipment/detail/057-92366691"

  '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.getElementByClassName("block-whisper")
    On Error GoTo 0
  Loop Until Not nodeTable Is Nothing
  
  'Get the status from the table
  MsgBox Trim(nodeTable.getElementsByClassName("fs-12 body-font-bold").innerText)
  
  'Clean up
  ie.Quit
  Set ie = Nothing
  Set nodeTable = Nothing
End Sub

Answer 1

Bazı temel bilgiler:
Mevcut olanlar gibi basit erişim için DOM (Belge Nesne Modeli) alma yöntemlerini kullanabilirsiniz. Ancak getElementByID()ve getElementsByClassName()/ arasında önemli bir fark vardır getElementsByTagName().

getElementByID()bir html etiketinin benzersiz kimliğini arar. Bu, html etiketlerine kimlik özelliği olarak yazılır. Html standardı sayfa tarafından tutulursa, bu benzersiz kimliğe sahip yalnızca bir öğe vardır. Yöntemin başlamasının nedeni budur getElement.

Yöntemi kullanırken kimlik bulunamazsa, VBA bir çalışma zamanı hatası atar. Bu nedenle çağrı, benden gelen diğer cevaptan hata işlemeyi kapatıp tekrar açmaya kadar döngü içinde kapsüllenir. Ancak bu sorunun sayfasında söz konusu html alanı için bir kimlik yok.

Bunun yerine, gerekli elemana doğrudan erişilebilir. İle erişimi denediniz getElementsByClassName(). Doğru. Ama işte fark geliyor getElementByID().

getElementsByClassName()ve ile getElementsByTagName()başlayın getElements. Bu çoğuldur çünkü istediğiniz kadar aynı sınıfa veya etiket adına sahip birçok öğe olabilir. Bu her iki yöntem de bir html düğüm koleksiyonu oluşturur. İstenen sınıf veya etiket adına sahip tüm html öğeleri bu koleksiyonlarda listelenecektir.

Bir dizi gibi tüm elemanların bir indeksi vardır. Dizinler 0'dan başlar. Belirli bir öğeye erişmek için istenen dizin belirtilmelidir. İki sınıf adı fs-12 body-font-bold(sınıf adları boşluklarla ayrılır, ayrıca yalnızca bir sınıf adı kullanarak bir düğüm koleksiyonu da oluşturabilirsiniz) düğüm koleksiyonuna 2 html öğesi sunar. İkincisini istiyorsun, bu yüzden 1. dizini kullanmalısın.

Bu, IE kullanılarak istenen sayfa için VBA kodudur:

Sub FlightStat_AF()

Dim url As String
Dim ie As Object

  'You can handle the parameters id and pfx in a loop to scrape dynamic numbers
  url = "https://www.afklcargo.com/mycargo/shipment/detail/057-92366691"

  '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 do that with a fix manual break of a few seconds
  'because the whole page will be "reload"
  'The last three values are hours, minutes, seconds
  Application.Wait (Now + TimeSerial(0, 0, 3))
  
  'Get the status from the table
  MsgBox Trim(ie.document.getElementsByClassName("fs-12 body-font-bold")(1).innerText)
  
  'Clean up
  ie.Quit
  Set ie = Nothing
End Sub

Düzenleme: İşlev olarak alt

Bu alt işlevi test etmek için:

Sub testFunction()
  Dim flightStatAfResult As String
  flightStatAfResult = FlightStat_AF("057-92366691")
  MsgBox flightStatAfResult
End Sub

Bu, işlev olarak alt:

Function FlightStat_AF(cargoNo As String) As String

Dim url As String
Dim ie As Object
Dim result As String

  'You can handle the parameters id and pfx in a loop to scrape dynamic numbers
  url = "https://www.afklcargo.com/mycargo/shipment/detail/" & cargoNo

  '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 do that with a fix manual break of a few seconds
  'because the whole page will be "reload"
  'The last three values are hours, minutes, seconds
  Application.Wait (Now + TimeSerial(0, 0, 3))
  
  'Get the status from the table
  result = Trim(ie.document.getElementsByClassName("fs-12 body-font-bold")(1).innerText)
  
  'Clean up
  ie.Quit
  Set ie = Nothing
  
  'Return value of the function
  FlightStat_AF = result
End Function