Question

我写了一个宏来从零售商的网页上抓取产品信息。它运行正常，但不会在我的工作表中呈现任何结果。我很难理解为什么。我进入＆＃34; sale＆＃34;进入搜索输入框，导致以下网址：

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

我想在我的工作表中找到产品的名称，以前的价格和当前价格。该这些元素的HTML如下：

<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>

代码如下：

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

非常感谢任何帮助。

编辑：嗨彼得，我感谢你的见解。它肯定会预先解决一些问题。但是，在编辑到缺少帐户的类名循环之前添加以下代码后，它仍然没有写入excel。

Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop

我错过了什么？

我也为不同零售商的网页提供了另一种方法，尽管是相同的概念，如下所示。你对这种方法有什么看法？我唯一的问题是Select Case行的Permission Denied Error 70。

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

再一次，谢谢你的帮助。

Answer 1

您的代码运行正常，有两个警告......

首先，在你＆＃34;点击＆＃34;主页面上的搜索按钮，您的代码不等待加载结果页面。因此，查找每个项目的循环失败，因为那里还没有任何东西。

其次，当您解析某些字段的HTML以处理缺少这些字段的情况时，您需要一些错误处理。例如，请查看此处的代码并将其应用于您的情况：

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

如何使用VBA中的getelementsbyclassname从在线零售商的网页上搜索产品名称和定价数据？

1 个答案: