Excel VBA Scrape amazon for inventory - vba

Question

I am seeking for scraping amazon inventory .. Here's the link I used
https://www.amazon.com/Stratford-Pharmaceuticals-Omega-Fatty-Strength/dp/B006JCU54Y/ref=sr_1_2?s=pet-supplies&ie=UTF8&qid=1518816130&sr=1-2&keywords=stratford
There is a part with the title "Compare with similar items" in which I need to extract prices (I have already done that) and also the inventory quantity ..
The second part is not directly obtained .. Manually I have to cick "Add to Cart" then from the next page click "Cart" then from the next page select "Quantity drop down and select 10+ and manually type any large number say 999 and click "Update"
There will be alert message that contains the remaining in inventory like that
(This seller has only 35 of these available. To see if more are available from another seller,) >> so this is the desired number which is 35
Here's the excel file and snapshots that illustrates the manual steps ..
I used IE but if it is possible to use XMLHTTP it would be great of course
Here's the code I devised till now
Sub Test()
Dim ws As Worksheet
Dim ie As Object
Dim allLnks As Object
Dim lnk As Object
Dim r As Long
Dim liElem As Object
Dim prElem As Object
Dim crtElem As Object
Dim elem As Object
Dim cnt As Integer
Dim inputElem As Object
Dim inputEle As Object
Set ws = ThisWorkbook.Worksheets("Sheet2")
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate ("https://www.amazon.com/Stratford-Pharmaceuticals-Omega-Fatty-Strength/dp/B006JCU54Y/ref=sr_1_2?s=pet-supplies&ie=UTF8&qid=1518816130&sr=1-2&keywords=stratford")
Do: DoEvents: Loop Until .readystate = 4
ws.Range("B2").Value = Format(Now(), "dd/mm/yyyy - hh:mm:ss")
Set liElem = .document.getelementbyid("detail-bullets").getelementsbytagname("table")(0).getelementsbytagname("ul")(0)
For Each elem In liElem.getelementsbytagname("li")
If InStr(elem.innerText, "ASIN") > 0 Then ws.Range("B1").Value = Replace(elem.innerText, "ASIN: ", "")
If InStr(elem.innerText, "Rank:") > 0 Then ws.Range("B3").Value = MyUDF(elem.innerText, "Rank: ", "(")
If InStr(elem.innerText, "Review:") > 0 Then ws.Range("B4").Value = Replace(Split(Trim(Split(elem.innerText, "Review: ")(1)), vbLf)(1), Chr(13), "")
Next elem
Set prElem = .document.getelementbyid("comparison_price_row")
For Each elem In prElem.getelementsbytagname("td")
cnt = cnt + 1
ws.Range("A" & cnt + 4).Value = "Seller " & cnt
ws.Range("B" & cnt + 4).Value = elem.getElementsByClassName("a-offscreen")(0).innerText
Next elem
cnt = 0
Set crtElem = .document.getelementbyid("HLCXComparisonTable").getElementsByClassName("a-button-inner")
For Each elem In crtElem
.navigate elem.getelementsbytagname("a")(0).href
Do: DoEvents: Loop Until .readystate = 4
.navigate .document.getElementsByClassName("a-button-inner")(0).getelementsbytagname("a")(0).href
Do: DoEvents: Loop Until .readystate = 4
cnt = cnt + 1
ws.Range("C" & cnt + 4).Value = Replace(Split(Split(MyUDF(.document.getElementsByClassName("a-row a-spacing-base sc-action-quantity sc-action-quantity-right")(0).innerHTML, "maxlength=", "quantity="), "autocomplete")(0), "=")(1), """", "")
Next elem
Stop
'.Quit
End With
End Sub
Function MyUDF(s As String, b As String, a As String) As String
Dim arr() As String
Dim r As String
arr = Split(s, b)
If UBound(arr) > 0 Then
r = arr(1)
arr = Split(r, a)
If UBound(arr) > 0 Then
r = arr(0)
End If
End If
MyUDF = Trim(r)
End Function
Here are snapshots that may help
]4

Answer 1

CSS Selector to get stock info
Taking the following example from your code:
You can use a CSS selector to target the text regarding stock levels.
.sc-product-availability
CSS query example using cart view page (generated by your code):
E.g. CSS query for associated cart view html
The . is the selector for ClassName.
VBA
You can use the .document.querySelectorAll method to retrieve a nodeList of the matching items (2 in the example)
Dim nodeList As Object
Set nodeList = .document.querySelectorAll(".sc-product-availability")
You would then loop over its length to retrieve items (not tested, but this is general method).
Dim i As Long
For i = 0 to nodeList.Length - 1
Debug.Print nodeList.Item(i).innerText
Next i
Hopefully that is useful to you.

Answer 2

Give it a try. It should fetch you the number you are after. I used xmlhttp and Selenium combinedly to make the script run a little faster. I could not use xmlhttp request in my second approach as the link were javascript encrypted.
Upon running the below script you can find out how many of these items the seller has. Even if the seller has no such items, the script will not break as I've already managed that.
There it is:
Sub GetInfo()
Const base As String = "https://www.amazon.com"
Const mainurl As String = "https://www.amazon.com/Stratford-Pharmaceuticals-Omega-Fatty-Strength/dp/B006JCU54Y/ref=sr_1_2?s=pet-supplies&ie=UTF8&qid=1518816130&sr=1-2&keywords=stratford"
Dim Http As New XMLHTTP60, Htmldoc As New HTMLDocument, itext As Object
Dim driver As New ChromeDriver, idic As New Scripting.Dictionary
Dim post As Object, oinput As Object, posts As Object, elem As Object
Dim idrop As Object, oclick As Object, I&, key As Variant
With Http
.Open "GET", mainurl, False
.send
Htmldoc.body.innerHTML = .responseText
End With
With Htmldoc.querySelectorAll("[id^='comparison_add_to_cart_'].a-button-text")
For I = 0 To .Length - 1
idic(base & Replace(.item(I).getAttribute("href"), "about:", "")) = 1
Next I
End With
For Each key In idic.keys
driver.get key
Set post = driver.FindElementByCss("input[value='addToCart']", Raise:=False, timeout:=10000)
If Not post Is Nothing Then
post.Click
End If
Set posts = driver.FindElementById("hlb-view-cart-announce", timeout:=10000)
posts.Click
Set elem = driver.FindElementByCss("span#a-autoid-0-announce", timeout:=10000)
elem.Click
Set idrop = driver.FindElementById("dropdown1_9", timeout:=10000)
idrop.Click
Set oinput = driver.FindElementByCss("input[name='quantityBox']", timeout:=10000)
oinput.SendKeys "100"
Set oclick = driver.FindElementByCss("#a-autoid-1", timeout:=10000)
oclick.Click
Set itext = driver.FindElementByCss(".sc-quantity-update-message span.a-size-base", Raise:=False, timeout:=5000)
If Not itext Is Nothing Then
R = R + 1: Cells(R, 1) = itext.Text
Else
R = R + 1: Cells(R, 1) = "Sorry dear nothing found"
End If
Next key
End Sub
Reference to add:
Selenium Type Library
Microsoft HTML Object Library
Microsoft XML, v6.0
Microsoft Scripting Runtime
Output you may get like below. Now, you can use regex to parse the number 48:
This seller has only 48 of these available. To see if more are available from another seller, go to the product detail page.