похвалить данные из атрибута - PullRequest
0 голосов
/ 25 апреля 2020

хочу получить значение атрибута "data-defaultasin" в столбцах b, c, d и т. Д. Из этих элементов (приведен снимок экрана).

url- https://www.amazon.in/dp/B06XTB2N7P продукта

проверить ss страница продукта рабочий лист

  Sub praseasin()
 Dim ASIN

 Dim doc As HTMLDocument
 Dim htmTable As HTMLTable
 Dim wb As Workbook: Set wb = ThisWorkbook
 Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
 Dim img As HTMLDocument
 Dim i, lastRow As Long
 lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
 For i = 3 To lastRow
     Set doc = New HTMLDocument
     With CreateObject("MSXML2.XMLHTTP")
         .Open "GET", ws.Cells(i, 1), True
         .send
         Do: DoEvents: Loop Until .readyState = 4
         Dim resp
         resp = .responseText
         .abort
     End With
    ' On Error Resume Next
     doc.body.innerHTML = resp
          Set ASIN = doc.getelementsbyclassname("swatchAvailable")

    ' On Error Resume Next
     r.Offset(0, 1).Value = li.getAttribute("data-defaultasin")
 Next
 End Sub




1 Ответ

1 голос
/ 25 апреля 2020

Попробуйте следующее, чтобы получить осины разных цветов и поместить их в разные столбцы. Это демонстрационный скрипт, в котором я использовал одну ссылку несколько раз. Измените его в соответствии с вашими потребностями. Спасибо.

Sub FetchAsin()
    Dim Http As New XMLHTTP60
    Dim Html As New HTMLDocument, I&, R&, C&
    Dim linkList As Variant, link As Variant

    linkList = Array( _
        "https://www.amazon.in/dp/B06XTB2N7P", _
        "https://www.amazon.in/dp/B06XTB2N7P", _
        "https://www.amazon.in/dp/B06XTB2N7P" _
    )

    For Each link In linkList
        With Http
            .Open "GET", link, False
            .send
            Html.body.innerHTML = .responseText
        End With

        With Html.querySelectorAll("[class^='swatch'][data-defaultAsin]")
            For I = 0 To .Length - 1
                C = C + 1: Cells(R + 1, C) = .Item(I).getAttribute("data-defaultAsin")
            Next I
            C = 0: R = R + 1
        End With
    Next link
End Sub

Ссылка для добавления в библиотеку:

Microsoft XML, v6.0
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...