excel - 易趣产品爬虫

Question

我对VBA非常有限，

代码在一个模块中，代码也有一个子进程，如果我发布错误的代码很抱歉

A) 打开 IE

B) 子进程获取数据。

该代码在 ebay.com 上运行良好，但不适用于 ebay.co.uk - 无法弄清楚原因，它还将 url 转换为超链接

它只做第一页，我需要它通过 X 数量的页面 - 有一个代码但不能让它工作，所以把它删除了。

搜索查询是否可以在 Ebay 打开之后运行，所以它打开，然后将搜索项输入到 ebay 然后代码运行，或者从一个单元格运行，如果它的单元格 A1 提取的数据需要粘贴到 A2 及以下。

我查看了 ebay.com 和 ebay.co.uk 的元素，它们对我来说看起来一样，所以无法弄清楚为什么它不能工作，因为它适用于 1 而不是另一个。

我确实输入了从几个页面获取数据的代码，但它不起作用。我知道当我从 google

获取 url 时，此代码可以正常工作

Public IE As New SHDocVw.InternetExplorer
Sub GetData()

    Dim HTMLdoc As MSHTml.HTMLDocument
    Dim othwb As Variant
    Dim objShellWindows As New SHDocVw.ShellWindows

    Set IE = CreateObject("internetexplorer.application")

        With IE
            .Visible = True
            '.Navigate "https://www.ebay.co.uk/sch/i.html?_from=R40&_trksid=m570.l1313&_nkw=jackets&_sacat=0"
            .Navigate "https://www.ebay.com/sch/i.html_from=R40&_nkw=ralph+lauren&_sacat=1059&LH_TitleDesc=0&_dmd=1&rt=nc"
            While .Busy Or .readyState <> 4: DoEvents: Wend

Set HTMLdoc = IE.document
                ProcessHTMLPage HTMLdoc

            .Quit
        End With


End Sub
code here

    enter 

'''''' THIS IS THE SUB PROCESS '''''


Sub ProcessHTMLPage(HTMLPage As MSHTml.HTMLDocument)

    Dim HTMLItem As MSHTml.IHTMLElement
    Dim HTMLItems As MSHTml.IHTMLElementCollection
    Dim HTMLInput As MSHTml.IHTMLElement
    Dim rownum As Long

    rownum = 1

    Set HTMLItems = HTMLPage.getElementsByClassName("s-item__title")

    For Each HTMLItem In HTMLItems

            Cells(rownum, 1).Value = HTMLItem.innerText
            rownum = rownum + 1

    Next HTMLItem

    rownum = 1

    Set HTMLItems = HTMLPage.getElementsByClassName("s-item__price")

    For Each HTMLItem In HTMLItems

            Cells(rownum, 2).Value = HTMLItem.innerText
            rownum = rownum + 1

    Next HTMLItem

    rownum = 1

  Set HTMLItems = HTMLPage.getElementsByClassName("s-item__link")
    For Each HTMLItem In HTMLItems
             Cells(rownum, 3).Value = HTMLItem.href
            rownum = rownum + 1

    Next HTMLItem

'Converts each text hyperlink selected into a working hyperlink from C1 to 25000 rows
  Range("C1:C25000").Select
    For Each xCell In Selection
        ActiveSheet.Hyperlinks.Add Anchor:=xCell, Address:=xCell.Formula
    Next xCell
Range("C1").Select
End Sub

跳转到下一页的代码

pageNumber = 1
'i = 2
    If pageNumber >= 6 Then Exit Do 'the first 6 pages
    internetdata.getElementById("pnnext").click 'next web page
    Do While internet.Busy Or internet.readyState <> 4
        DoEvents
    Loop
    Set internetdata = internet.document
    pageNumber = pageNumber + 1
Loop

不适用于 Ebay.co.uk - 未提取任何结果 - 在 ebay.com

中工作正常

需要它从 X 数量的页面中获取数据，而不仅仅是 1 页

搜索查询是否可以在 Ebay 打开之后运行，所以它打开，然后将搜索项输入到 ebay 然后代码运行，或者从一个单元格运行，如果它的单元格 A1 提取的数据需要粘贴到 A2 及以下。

这是我的谷歌搜索代码，我已经让它工作了，所以搜索来自单元格 A1，我正在寻找类似的东西，我将看看我是否可以使用 ebay 代码。因为这也是谷歌搜索的前 25 页

enter Sub webpage()

Dim ie As Object
Dim htmlDoc As Object
Dim nextPageElement As Object
Dim div As Object
Dim link As Object
Dim url As String
Dim pageNumber As Long
Dim i As Long

' Takes seach from A1 and places it into google
url = "https://www.google.co.uk/search?q=" & Replace(Worksheets("Sheet1").Range("A1").Value, " ", "+")


Set ie = CreateObject("InternetExplorer.Application")

With ie
    .Visible = True
    .navigate url
    Do While .Busy Or .readyState <> 4
        DoEvents
    Loop
End With


Application.Wait Now + TimeSerial(0, 0, 5)

Set htmlDoc = ie.document


pageNumber = 1
i = 2
Do
    For Each div In htmlDoc.getElementsByTagName("div")
        If div.getAttribute("class") = "r" Then
            Set link = div.getElementsByTagName("a")(0)
            Cells(i, 2).Value = link.getAttribute("href")
            i = i + 1
        End If
    Next div
    If pageNumber >= 25 Then Exit Do 'the first 25 pages
    Set nextPageElement = htmlDoc.getElementById("pnnext")
    If nextPageElement Is Nothing Then Exit Do

    ' Clicks web next page
    nextPageElement.Click 'next web page
    Do While ie.Busy Or ie.readyState <> 4
        DoEvents
    Loop
    Application.Wait Now + TimeSerial(0, 0, 5)
    Set htmlDoc = ie.document
    pageNumber = pageNumber + 1
Loop


MsgBox "All Done"

Set ie = Nothing
Set htmlDoc = Nothing
Set nextPageElement = Nothing
Set div = Nothing
Set link = Nothing

结束子
代码在这里

Answer 1

问题 1:为什么它适用于一个域而不适用于另一个域？

要回答问题 1(其他问题应该是新帖子) - html 根本不一样。在 ebay.co.uk 中找不到适用于 ebay.com 的类(class)；因此，您对集合的循环不会做任何事情，因为它们的计数为 0(如果使用 querySelectorAll，则使用 nodeLists 的长度为 0)。相反，您需要分支代码。根据 url 域设置选择器。

我使用了 css 选择器，因为这是选择所需元素的最简单、最快的方法，同时保持代码重构的灵 active 以减少重复代码的行数。

旁注:

如果您不确定您的选择方法是否适用于不同的页面，您至少可以做两件事:

右键单击 > 检查元素 > 目视检查您尝试比较的元素的类名是否相同。那么，如果您正在查看产品名称，那么 html 中的类名在两个页面上是否相同？

您可以使用浏览器的搜索工具 > 通过 F12 打开元素选项卡，然后按 Ctrl+F 拉出搜索框 > 在第二页的此框中输入您的类名，然后按 Enter。您还可以在此处输入 css 选择器和某些情况下的正则表达式。您将获得一个命中计数，告诉您找到了多少匹配项。您可以按住回车键循环匹配，每个匹配都会在上面的 html 中突出显示，因此您可以轻松比较匹配的结果是否符合您的预期。

点击图片放大



图片网址: /image/MWkEx.png

VBA:

Option Explicit

Public Sub GetData()
    Dim htmlDoc As MSHTML.HTMLDocument, ie As SHDocVw.InternetExplorer, ws As Worksheet

    Set ie = New SHDocVw.InternetExplorer
    Set htmlDoc = New MSHTML.HTMLDocument
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With ie
        .Visible = True
        '.Navigate2 "https://www.ebay.co.uk/sch/i.html?_from=R40&_trksid=m570.l1313&_nkw=jackets&_sacat=0"
        .Navigate2 "https://www.ebay.com/sch/i.html_from=R40&_nkw=ralph+lauren&_sacat=1059&LH_TitleDesc=0&_dmd=1&rt=nc"
        While .Busy Or .readyState <> 4: DoEvents: Wend

        Dim index As Long, HTMLItems As Object, rowNum As Long, xCell As Range
        Dim cssSelectors(), i As Long

        Select Case True
        Case InStr(.document.URL, "ebay.co.uk") > 0
            cssSelectors = Array(".gvtitle a", ".amt", ".gvtitle a")
        Case InStr(.document.URL, "ebay.com") > 0
            cssSelectors = Array(".s-item__title", ".s-item__price", ".s-item__link")
        End Select

        With ws
            For i = LBound(cssSelectors) To UBound(cssSelectors)
                rowNum = 1
                Set HTMLItems = ie.document.querySelectorAll(cssSelectors(i))

                For index = 0 To HTMLItems.length - 1
                    .Cells(rowNum, i + 1).Value = IIf(i = 2, HTMLItems.item(index).getAttribute("href"), HTMLItems.item(index).innerText)
                    rowNum = rowNum + 1
                Next
            Next
            For Each xCell In .Range("C1:C25000") '<= all these really?
                .Hyperlinks.Add Anchor:=xCell, Address:=xCell.Formula
            Next xCell
        End With
        .Quit
    End With
End Sub