Question

我对VBA的了解非常有限

该代码位于模块中，该代码也具有子进程，因此，如果我输入的代码错误，抱歉！

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

该代码在ebay.com上可以正常运行，但在ebay.co.uk上则不能正常工作-无法弄清原因，还将网址转换为超链接
它仅处理第一页，我需要它浏览X的页面-有代码但无法正常工作，因此将其删除。
是否可以在打开Ebay后打开搜索查询，将其打开，然后将搜索项输入到ebay，然后运行代码，或者从某个单元格运行，如果要粘贴其单元格A1，则需要粘贴提取的数据在A2及以下版本中。

我已经查看了ebay.com和ebay.co.uk的元素，它们对我来说看起来是相同的，因此无法弄清楚为什么它不起作用，因为它适用于1，而不适用于其他。< / p>
我确实输入了从几页中获取数据的代码，但没有用。我知道从Google

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及以下版本中。

这是我用于Google搜索的代码，它可以正常工作，因此搜索来自单元格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。相反，您需要分支代码。根据网址域设置选择器。

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

旁注：

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

右键单击>检查元素>目视检查要比较的元素的类名称是否相同。因此，如果您正在查看产品名称，那么两个页面中html中的类名称是否相同？
您可以使用浏览器的搜索工具>通过 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

Answer 2

如果此方法在eBay上有效，则您需要了解为什么它在ebay.co.uk上不起作用。我的观点是，如果代码本身能够正常工作，那么我们在这里没有什么可以帮助您的。您需要花一些时间来调查ebay.co.uk并查找差异，因为我敢肯定这是次要的。我无法帮助您修复实际上没有损坏的代码。我希望你好运。

eBay产品刮板

2 个答案: