易趣产品刮刀

Question

我对 VBA 非常有限，

代码在一个模块中，代码也有一个子进程，如果我把代码贴错了，很抱歉

• A) 打开 IE
• B) 子进程获取数据。

---

1. 该代码在 ebay.com 上运行良好，但不适用于 ebay.co.uk - 不知道为什么，它还将 url 转换为超链接

2. 它只做第一页，我需要它浏览 X 个页面 - 有一个代码但无法让它工作，所以已将其删除。

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

---

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

2. 我确实输入了从几个页面获取数据的代码，但它不起作用。我知道当我从谷歌获取 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

1. 在 Ebay.co.uk 上不起作用 - 没有提取结果 - 在 ebay.com 上工作正常

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

3. 是否可以在 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 的课程；因此，您对集合的循环不会执行任何操作，因为它们的计数为 0（如果使用 querySelectorAll，则节点列表的长度为 0）。相反，您需要分支代码。根据 url 域设置选择器。

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

边注：

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

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

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

_{点击图片放大}

img 网址：https : //i.stack.imgur.com/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