Vba Script fix
Budget: €8 – €30 EUR
Hello,
I'm using a Vba script in order to scap data, but it doesnt' working more.
I need to fix
This is the script
Sub pro1()
Dim m As Integer
'If VBA.Day(Now()) = 8 And VBA.Month(Now()) = 9 And VBA.Year(Now()) = 2022 Then
Dim element As IHTMLElement
Dim elements As IHTMLElementCollection
Dim IE As Object
Dim html As HTMLDocument
Set IE = CreateObject("InternetExplorer.Application")
'If you want to see the internet explorer window you should type down as True otherwise False
IE.Visible = True
For m = 2 To Sheet1.Range("A" & Rows.count).End(xlUp).Row
If Sheet1.Range("B" & m) = "" Then GoTo lab2:
Url = "https://www.amazon.it/s?k=" & Sheet1.Range("B" & m) & "&__mk_it_IT=%C3%85M%C3%85%C5%BD%C3%95%C3%91&crid=2J09C1LHL9BH2&sprefix=" & Sheet1.Range("B" & m) & "%2Caps%2C184&ref=nb_sb_noss"
IE.navigate Url
'Wait until IE has loaded the web page
Do While IE.readyState <> READYSTATE_COMPLETE
Application.StatusBar = " Loading Web page … "
DoEvents
Loop
Application.Wait (Now() + TimeValue("00:00:02"))
Set html = IE.document
On Error Resume Next
html.getElementById("sp-cc-accept").Click
On Error GoTo 0
Set elements = html.getElementsByClassName("sg-col-inner")
'Here is the className "priceblock_ourpirce" I found it in InspectElement but its not getting any data. I am not able to find the 'correct ClassName for Price and Name of Product from InspectElemnt. As I am not a web developer.
Dim count As Long
Dim erow As Long
If InStr(html.getElementsByClassName("a-row")(0).innerText, "Nessun risultato per ") > 0 Then
Sheet1.Range("C" & m) = html.getElementsByClassName("a-row")(0).innerText
Sheet1.Range("D" & m) = html.getElementsByClassName("a-row")(0).innerText
Sheet1.Range("E" & m) = html.getElementsByClassName("a-row")(0).innerText
Sheet1.Range("F" & m) = html.getElementsByClassName("a-row")(0).innerText
GoTo lab2:
Else
If elements.Length > 0 Then
count = Split(elements(0).innerText, " ")(0)
Else
End If
End If
If count >= 1 Then
j = False
Set ele = html.getElementsByClassName("rush-component s-latency-cf-section")
For Each e In ele
For Each i In e.getElementsByTagName("span")
If InStr(i.innerText, "RISULTATI") > 0 Then
j = True
k = 1
GoTo lab159:
End If
If j = True And k = 2 Then
i.Click
j = False
k = 1
GoTo lab1:
End If
If k = 1 Then
k = 2
End If
lab159:
Next i
Next e
Else
End If
lab1:
Application.Wait (Now() + TimeValue("00:00:02"))
On Error Resume Next
ratings = VBA.Split(html.getElementById("acrCustomerReviewText").innerText, " ")(0)
Price = html.getElementsByClassName("a-offscreen")(0).innerText
For Each i In html.getElementById("productDetails_detailBullets_sections1").document.getElementsByTagName("tr")
If InStr(i.innerText, "ASIN") > 0 Then
Asin = Right(VBA.Split(i.innerText, "ASIN")(1), 11)
GoTo lab195:
End If
Next i
lab195:
Sheet1.Range("C" & m) = ratings
Sheet1.Range("D" & m) = Price
Sheet1.Range("E" & m) = link
Sheet1.Range("F" & m) = Asin
ratings = ""
Price = ""
link = ""
Asin = ""
lab2:
Next m
MsgBox "Fetching done."
End Sub
I'm using a Vba script in order to scap data, but it doesnt' working more.
I need to fix
This is the script
Sub pro1()
Dim m As Integer
'If VBA.Day(Now()) = 8 And VBA.Month(Now()) = 9 And VBA.Year(Now()) = 2022 Then
Dim element As IHTMLElement
Dim elements As IHTMLElementCollection
Dim IE As Object
Dim html As HTMLDocument
Set IE = CreateObject("InternetExplorer.Application")
'If you want to see the internet explorer window you should type down as True otherwise False
IE.Visible = True
For m = 2 To Sheet1.Range("A" & Rows.count).End(xlUp).Row
If Sheet1.Range("B" & m) = "" Then GoTo lab2:
Url = "https://www.amazon.it/s?k=" & Sheet1.Range("B" & m) & "&__mk_it_IT=%C3%85M%C3%85%C5%BD%C3%95%C3%91&crid=2J09C1LHL9BH2&sprefix=" & Sheet1.Range("B" & m) & "%2Caps%2C184&ref=nb_sb_noss"
IE.navigate Url
'Wait until IE has loaded the web page
Do While IE.readyState <> READYSTATE_COMPLETE
Application.StatusBar = " Loading Web page … "
DoEvents
Loop
Application.Wait (Now() + TimeValue("00:00:02"))
Set html = IE.document
On Error Resume Next
html.getElementById("sp-cc-accept").Click
On Error GoTo 0
Set elements = html.getElementsByClassName("sg-col-inner")
'Here is the className "priceblock_ourpirce" I found it in InspectElement but its not getting any data. I am not able to find the 'correct ClassName for Price and Name of Product from InspectElemnt. As I am not a web developer.
Dim count As Long
Dim erow As Long
If InStr(html.getElementsByClassName("a-row")(0).innerText, "Nessun risultato per ") > 0 Then
Sheet1.Range("C" & m) = html.getElementsByClassName("a-row")(0).innerText
Sheet1.Range("D" & m) = html.getElementsByClassName("a-row")(0).innerText
Sheet1.Range("E" & m) = html.getElementsByClassName("a-row")(0).innerText
Sheet1.Range("F" & m) = html.getElementsByClassName("a-row")(0).innerText
GoTo lab2:
Else
If elements.Length > 0 Then
count = Split(elements(0).innerText, " ")(0)
Else
End If
End If
If count >= 1 Then
j = False
Set ele = html.getElementsByClassName("rush-component s-latency-cf-section")
For Each e In ele
For Each i In e.getElementsByTagName("span")
If InStr(i.innerText, "RISULTATI") > 0 Then
j = True
k = 1
GoTo lab159:
End If
If j = True And k = 2 Then
i.Click
j = False
k = 1
GoTo lab1:
End If
If k = 1 Then
k = 2
End If
lab159:
Next i
Next e
Else
End If
lab1:
Application.Wait (Now() + TimeValue("00:00:02"))
On Error Resume Next
ratings = VBA.Split(html.getElementById("acrCustomerReviewText").innerText, " ")(0)
Price = html.getElementsByClassName("a-offscreen")(0).innerText
For Each i In html.getElementById("productDetails_detailBullets_sections1").document.getElementsByTagName("tr")
If InStr(i.innerText, "ASIN") > 0 Then
Asin = Right(VBA.Split(i.innerText, "ASIN")(1), 11)
GoTo lab195:
End If
Next i
lab195:
Sheet1.Range("C" & m) = ratings
Sheet1.Range("D" & m) = Price
Sheet1.Range("E" & m) = link
Sheet1.Range("F" & m) = Asin
ratings = ""
Price = ""
link = ""
Asin = ""
lab2:
Next m
MsgBox "Fetching done."
End Sub