Ürün adı ve fiyatlandırma verilerini VBA'da getelementsbyclassname kullanarak çevrimiçi bir perakendecinin web sayfasından nasıl tarayabilirim?

Question

Bir perakendecinin web sayfasından ürün bilgilerini almak için bir makro yazdım. İyi çalışıyor ancak çalışma sayfamda hiç sonuç vermiyor. Nedenini anlamakta zorlanıyorum. Aşağıdaki url yol arama inputbox içine "satış" girin:

http://www.shopjustice.com/search/?q=sale&originPageName=home

Ben ürünün adı, eski fiyat, ve benim çalışma sayfasında güncel fiyatı istiyorum. aşağıdaki gibi bu unsurlar için HTML şu şekildedir:

<div class="subCatName"> 
      <a href="/girls-clothing/colored-jeggings/6611358/651?pageSort=W3sidHlwZSI6InJlbGV2YW5jZSIsInZhbCI6IiJ9XQ==&amp;productOrigin=search%20page&amp;productGridPlacement=1-1" id="anchor2_6611358" class="auxSubmit">Colored Jeggings</a> 
     </div> 
<div class="cat-list-price subCatPrice"> 
      <div class="priceContainer"> 
       <span class="mobile-was-price"> 
          was 
          $26.90</span> 
         <span class="mobile-now-price"> 
          now 
          $10.49</span> 
        </div> 

      <div class="price_description"> 
         <span class="mobile-extra"> 
          Extra 30% off clearance!</span> 
        </div>    
       </div> 

kodudur:

Sub test2() 

Dim RowCount, erow As Long 
Dim sht As Object 
Dim ele As IHTMLElement 
Dim eles As IHTMLElementCollection 
Dim doc As HTMLDocument 

Set sht = Sheets("JUSTICESALE") 
RowCount = 1 
sht.Range("A" & RowCount) = "Clothing Item" 
sht.Range("B" & RowCount) = "SKU" 
sht.Range("C" & RowCount) = "Former Price" 
sht.Range("D" & RowCount) = "Sale Price" 

Set ie = CreateObject("InternetExplorer.application") 
searchterm = InputBox("ENTER SEARCH TERM") 

Application.StatusBar = "LOADING JUSTICE SEARCH" 
With ie 
.Visible = True 
.navigate "http://www.shopjustice.com/" 

Do While .busy Or _ 
.readystate <> 4 
DoEvents 
Loop 

Set doc = ie.document 

doc.getelementsbyname("q").Item.innertext = searchterm 
doc.getElementsByClassName("searchbtn").Item.Click 

Application.StatusBar = "EXTRACTING PRODUCT DATA" 

Set eles = doc.getElementsByClassName("subCatName") 
For Each ele In eles 
If ele.className = "subCatName" Then 
erow = sht.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row 
Cells(erow, 1) = doc.getElementsByClassName("auxSubmit")(RowCount).innertext 
Cells(erow, 2) = doc.getElementsByClassName("mobile-was-price")(RowCount).innertext 
RowCount = RowCount + 1 

End If 

Next ele 

End With 

Set ie = Nothing 

Application.StatusBar = "" 

End Sub 

Herhangi bir yardım çok takdir edilecektir.

EDIT: Merhaba Peter, içgörünüzü takdir ediyorum. Kesinlikle bazı problemleri önceden boşaltmıştır. Ancak, aşağıdaki kod, hesaptan-için-eksik-classname döngüsünden önce eklendikten sonra, yine de excel'e yazmıyor.

Do While ie.readyState <> READYSTATE_COMPLETE 
DoEvents 
Loop 

Neyi eksik?

Farklı bir perakendeci web sayfası için, aşağıda gösterildiği gibi aynı konsepti de içeren alternatif bir yöntem oluşturdum. Bu yöntemle ilgili düşünceleriniz nelerdir? Tek sorunum, Select Case satırında bir İzin Reddedildi Hatası 70'tir.

Sub test5() 

Dim erow As Long 
Dim ele As Object 

Set sht = Sheets("CARTERS") 
RowCount = 1 
sht.Range("A" & RowCount) = "Clothing Item" 
sht.Range("B" & RowCount) = "SKU" 
sht.Range("C" & RowCount) = "Former Price" 
sht.Range("D" & RowCount) = "Sale Price" 

erow = Sheet1.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row 

Set objIE = CreateObject("Internetexplorer.application") 

searchterm = InputBox("ENTER CARTER'S SEARCH TERM") 

With objIE 
.Visible = True 
.navigate "http://www.carters.com/" 

Do While .Busy Or _ 
.readyState <> 4 
DoEvents 
Loop 

.document.getElementsByName("q").Item.innerText = searchterm 
.document.getElementsByClassName("btn_search").Item.Click 

Do While .readyState <> READYSTATE_COMPLETE 
DoEvents 
Loop 

For Each ele In .document.all 
Select Case ele.className 

Case “product - name” 
RowCount = RowCount + 1 
sht.Range("A" & RowCount) = ele.innerText 

Case “product - standard - price” 
sht.Range("B" & RowCount) = ele.innerText 

Case "product-sales-price" 
sht.Range("C" & RowCount) = ele.innerText 

End Select 
Next ele 
End With 

Set objIE = Nothing 

End Sub 

Ve bir kez daha, yardımlarınız için teşekkür ederim.

Answer 1

Kodunuz sonuçları sayfanın yüklenmesi için kod beklemiyor,

Öncelikle senden sonra ana sayfasındaki arama butonuna "tıklama" İki uyarılar ... ile, gayet güzel çalışıyor. Bu nedenle, her bir öğe için görünen döngünüz başarısız olur, çünkü orada hiçbir şey yoktur (henüz).

İkincisi, bu alanlar eksik olduğunda durumun üstesinden gelmek için HTML'yi ayrıştırırken bazı hataları ele almanız gerekir. Bir örnek olarak, burada kod bakmak ve durumunuza uygulama: Sen İzin Verilmedi hata alıyorsanız

For Each ele In eles 
    If ele.className = "subCatName" Then 
     erow = sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
     On Error Resume Next 
     Cells(erow, 1) = doc.getElementsByClassName("auxSubmit")(RowCount).innerText 
     If Err.Number <> 0 Then 
      Cells(erow, 1) = "ERR: 'auxSubmit' Class Name Not Found!" 
      Err.Clear 
     Else 
     End If 
     Cells(erow, 2) = doc.getElementsByClassName("mobile-was-price")(RowCount).innerText 
     If Err.Number <> 0 Then 
      Cells(erow, 2) = "ERR: 'mobile-was-price' Class Name Not Found!" 
      Err.Clear 
     End If 
     On Error GoTo 0 
     RowCount = RowCount + 1 
    End If 
Next ele