eBay Продукт скребок

Question

Я очень ограничен в VBA,

Код находится в модуле, код также имеет подпроцесс, поэтому извините, если я отправил код неправильно

• А) открыть 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-адреса из 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

1. Не работает на Ebay.co.uk - НИКАКИХ РЕЗУЛЬТАТОВ НЕ ИЗВЛЕЧЕНО - Работает нормально на ebay.com

2. Требуется получить данные с количества страниц X, а НЕ только с 1 страницы

3. Можно ли выполнить поисковый запрос ПОСЛЕ открытия Ebay, поэтому он открывается, затем элемент поиска вводится в ebay, а затем выполняется код или выполняется из ячейки, ЕСЛИ в ее ячейке A1 извлеченные данные необходимо вставить в A2 и ниже.

Это мой код для поиска в Google, он у меня работает, поэтому поиск идет из ячейки A1, я ищу что-то подобное, я собираюсь посмотреть, смогу ли я использовать код ebay с этим. Как это также делает первые 25 страниц в поиске Google

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

End Sub код здесь

Answer 1

Вопрос 1: Почему это работает для одного домена, а не для другого?

Чтобы ответить на вопрос 1 (другие вопросы должны быть новыми сообщениями) - HTML не то же самоесовсем.Классы, которые работают для ebay.com, не найдены в ebay.co.uk;Итак, ваш цикл по коллекциям ничего не делает, потому что они имеют длину 0. Вместо этого вам нужен разветвленный код.Установите ваши селекторы на основе домена url.

Я использовал селекторы css, так как это самый простой и быстрый способ выбора необходимых элементов при сохранении гибкости перефакторинга кода для уменьшения количества строк.повторный код.

---

Примечание:

Если вы не уверены, будет ли ваш метод выбора работать на разных страницах, вы можете сделать по крайней мере две вещи:

1. Щелкните правой кнопкой мыши> осмотреть элемент> визуально проверить, совпадают ли имена классов для элементов, которые вы пытаетесь сравнить.Итак, если вы смотрите на названия продуктов, одинаковые ли имена классов в html на обеих страницах?

2. Вы можете использовать средство поиска браузера> вкладка открытых элементов через F12 , затем нажмите Ctrl + F , чтобы открыть окно поиска> введите имя своего класса с первой страницы в это поле на второй странице и нажмите Enter.Вы также можете ввести селекторы CSS здесь и в некоторых случаях регулярное выражение.Вы получите счетчик совпадений, сообщающий вам, сколько совпадений найдено.Вы можете продолжать нажимать клавишу ввода, чтобы циклически проходить матчи, и каждый матч будет выделен в HTML-коде выше, так что вы можете легко сравнить, соответствуют ли результаты ожидаемым.

_{нажмите на изображение, чтобы увеличить его}

img url: 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 и найти различия, так как я уверен, что это что-то незначительное.Я не могу помочь тебе исправить код, который на самом деле не сломан.Я желаю вам удачи, хотя.