dimanche 24 novembre 2019

VBA web scraping update

I have following code it:

  1. open a webpage (amazon in this case)
  2. click on all the products appearing on the page ( and open each product in new tab)
  3. go through each open tab (from step 2), copy the "product title" and paste it to column A

Can you help me to update the code to include a loop:

  1. which go through each open tab (from step 2) and copy the price element and paste it in column B corresponding to product title

The HTML element is for the price is "649"

Sub launch_product()
Dim IE As SHDocVw.InternetExplorer
Dim idoc As MSHTML.HTMLDocument
Dim doc_ele As MSHTML.IHTMLElement
Dim doc_eles As MSHTML.IHTMLElementCollection

Dim startoftitle As Integer, endoftitle As Integer, rownum As Long
Dim vouterHTML As String, ProductTitle As String

Set IE = New SHDocVw.InternetExplorer
IE.Visible = True
IE.Navigate "https://www.amazon.in/s?k=rudra+fashion&rh=p_n_size_two_browse-vebin%3A1975333031&dc&crid=2AKWK100N33Q9&qid=1574534623&rnid=1974754031&sprefix=rudra+fas%2Caps%2C287&ref=sr_nr_p_n_size_two_browse-vebin_8"

Do While IE.ReadyState <> READYSTATE_COMPLETE
   Application.StatusBar = "Loading"
Loop
Set idoc = IE.Document

Set doc_eles = idoc.getElementsByTagName("img")
rownum = 1

For Each doc_ele In doc_eles
    If doc_ele.className = "s-image" Then
       doc_ele.Click

       vouterHTML = doc_ele.outerHTML
       startoftitle = InStr(1, vouterHTML, "alt=") + 5
       endoftitle = InStr(startoftitle, vouterHTML, """") - 1
       ProductTitle = Mid(vouterHTML, startoftitle, endoftitle - startoftitle + 1)
       ActiveSheet.Cells(rownum, 1).Value = ProductTitle
       rownum = rownum + 1
    End If
Next doc_ele

ActiveSheet.Columns(1).EntireColumn.AutoFit
IE.Quit

End Sub




Aucun commentaire:

Enregistrer un commentaire