Царапать значение спецификации продукта - PullRequest
0 голосов
/ 20 апреля 2020

Я пытаюсь очистить спецификации продукта от Amazon, используя VBA. HTML Страница для очистки: https://www.amazon.in/dp/B01FXJI1OY

enter image description here

У меня есть два широких требования: 1) Разбить название продукта на получить определенные спецификации 2) Получить остальные спецификации от Bullet points (BP), упомянутых на странице

Решение, о котором я подумал (пожалуйста, предложите, если вы думаете, что есть лучший способ сделать this): используйте текстовые идентификаторы (которые являются значением spec или текстом, который идет после значения spe c):

enter image description here

Мой текущий код возможность получить название продукта. Он также выбирает точки маркера, соответствующие значению, сохраненному в ячейке (2,2). Пожалуйста, помогите, как я могу получить значение спецификации, используя идентификатор (который кратен некоторым характеристикам, таким как месяц / год для гарантии):

Sub GetchDetails()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Dim IE As Object ' InternetExplorer.Application
Dim url As String

Dim sh As Worksheet
Dim rw As Range

ThisWorkbook.Sheets("Crawler").Activate

Set sh = ActiveSheet



    Set IE = CreateObject("InternetExplorer.Application")
   ' IE.Visible = True
    url = "https://amazon.in/dp/B01FXJI1OY"


     On Error Resume Next

    IE.Navigate2 url
    Do While IE.Busy = True Or IE.readystate <> 4
       DoEvents
    Loop

    Set HTMLDoc = IE.document
    Application.Wait (Now + TimeValue("0:00:01"))

    Option Compare Text

    Set itm = HTMLDoc.getElementById("productTitle")
    Cells(rw.Row, 3).Value = itm.innertext 

    Set itm = HTMLDoc.getElementsByClassName("a-unordered-list a-vertical a-spacing-none")(0)


    i = 0
    For Each Item In itm.getElementsByTagName("li")
    If LCase(Item.innertext) Like "*" & LCase(Cells(2, 2)) & "*" Then

    Cells(rw.Row, 5 + i).Value = Item.innertext
     i = i + 1
     End If

   Next Item

1 Ответ

0 голосов
/ 23 апреля 2020

Я думаю ... как-то так ... для начала. Конечно, вы можете изменить его в соответствии со своими потребностями.

Sub WebImport()

Dim objIE As Object

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

URL = "https://amazon.in/dp/B01FXJI1OY"

'Wait for site to fully load
IE.Navigate2 URL
Do While IE.Busy = True
   DoEvents
Loop

RowCount = 1

With Sheets("Sheet1")
   .Cells.ClearContents
   RowCount = 1

    For Each itm In IE.document.all

        If itm.classname = "a-unordered-list a-vertical a-spacing-none" Then
            .Range("A" & RowCount) = itm.classname
            .Range("B" & RowCount) = itm.innerText
            RowCount = RowCount + 1
        End If

    Next itm

End With
End Sub

Результат:

enter image description here

...