Extract price and seller data from Amazon - excel

Question

I am using below code to extract data from Amazon.
Sub Macro1()
' Macro1 Macro
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.amazon.com/gp/offer-listing/B00N41UTWG/ref=olp_f_new?ie=UTF8&f_new=true" _
, Destination:=Range("$A$1"))
.Name = "oldOfferPrice" _
' "its_details_value_node.html?nsc=true&listId=www_s201_b9233&tsId=BBK01.ED0439"
.FieldNames = True
.RowNumbers = True
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = True
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
Above code is extracting complete page data but my requirement is to extract only prices. Page prices are in this format.
<div class="a-row a-spacing-mini olpOffer">
<div class="a-column a-span2">
<span class="a-size-large a-color-price olpOfferPrice a-text-bold"> $171.99 </span>
<span class="a-color-price">
<span class="supersaver"><i class="a-icon a-icon-prime" aria-label="Amazon Prime TM"><span class="a-icon-alt">Amazon Prime TM</span></i></span>
</span>
I want to extract two values i.e $171.99 and Amazon Prime TM. There may be multiple price and seller values in one page and I want to extract all.

Answer 1

Here is an example showing how you can retrieve Amazon offers for certain ASIN using XHR and Split, and output results to the sheet:
Sub TestExtractAmazonOffers()
Dim arrList() As Variant
' clear sheet
Sheets("Sheet1").Cells.Delete
' retrieve offers for certain ASIN
arrList = ExtractAmazonOffers("B07CR8D2DW")
' output data
Output Sheets("Sheet1"), 1, 1, arrList
End Sub
Function ExtractAmazonOffers(strASIN As String)
Dim strUrl As String
Dim arrTmp() As String
Dim strTmp As String
Dim arrItems() As String
Dim i As Long
Dim arrCols() As String
Dim strSellerName As String
Dim strOfferPrice As String
Dim strAmazonPrime As String
Dim strShippingPrice As String
Dim arrResults() As Variant
Dim arrCells() As Variant
' init
arrResults = Array(Array("Offer Price", "Amazon Prime TM", "Shipping Price", "Seller Name"))
strUrl = "https://www.amazon.com/gp/offer-listing/" & strASIN & "/ref=olp_f_new?ie=UTF8&f_new=true"
Do
' http get request of the search result page
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", strUrl, False
.Send
strResp = .ResponseText
End With
arrTmp = Split(strResp, "id=""olpOfferList""", 2)
If UBound(arrTmp) = 1 Then
arrItems = Split(arrTmp(1), "<div class=""a-row a-spacing-mini olpOffer""")
For i = 1 To UBound(arrItems)
' get item columns
arrCols = Split(arrItems(i), "<div class=""a-column", 6)
' retrieve seller name from column 4
strTmp = Split(arrCols(4), "olpSellerName", 2)(1)
arrTmp = Split(strTmp, "alt=""", 2)
If UBound(arrTmp) = 1 Then ' from image alt
strTmp = Split(arrTmp(1), """", 2)(0)
strSellerName = Trim(strTmp)
Else ' from link
strTmp = Split(strTmp, "<a", 2)(1)
strTmp = Split(strTmp, ">", 2)(1)
strTmp = Split(strTmp, "<", 2)(0)
strSellerName = Trim(strTmp)
End If
' retrieve offer price from column 1
strTmp = Split(arrCols(1), "olpOfferPrice", 2)(1)
strTmp = Split(strTmp, ">", 2)(1)
strTmp = Split(strTmp, "<", 2)(0)
strOfferPrice = Trim(strTmp)
' retrieve amazon prime
arrTmp = Split(arrCols(1), "olpShippingInfo", 2)
strAmazonPrime = IIf(InStr(arrTmp(0), "Amazon Prime") > 0, "Amazon Prime", "-")
' retrieve shipping info
arrTmp = Split(arrTmp(1), "olpShippingPrice", 2)
If UBound(arrTmp) = 1 Then
strTmp = Split(arrTmp(1), ">", 2)(1)
strTmp = Split(strTmp, "<", 2)(0)
strShippingPrice = Trim(strTmp)
Else
strShippingPrice = "Free"
End If
' store data
ReDim Preserve arrResults(UBound(arrResults) + 1)
arrResults(UBound(arrResults)) = Array(strOfferPrice, strAmazonPrime, strShippingPrice, strSellerName)
Next
End If
' search for next page link
arrTmp = Split(strResp, "class=""a-last""", 2)
If UBound(arrTmp) = 0 Then Exit Do
strTmp = Split(arrTmp(1), "href=""", 2)(1)
strUrl = Split(strTmp, """", 2)(0)
If Left(strUrl, 1) = "/" Then strUrl = "https://www.amazon.com" & strUrl
Loop
' convert nested array to 2-dimensional array
ReDim arrCells(UBound(arrResults), 3)
For i = 0 To UBound(arrCells, 1)
For j = 0 To UBound(arrCells, 2)
arrCells(i, j) = arrResults(i)(j)
Next
Next
ExtractAmazonOffers = arrCells
End Function
Sub Output(objSheet As Worksheet, lngTop As Long, lngLeft As Long, arrCells As Variant)
With objSheet
.Select
With .Range(.Cells(lngTop, lngLeft), .Cells( _
UBound(arrCells, 1) - LBound(arrCells, 1) + lngTop, _
UBound(arrCells, 2) - LBound(arrCells, 2) + lngLeft))
.NumberFormat = "#"
.Value = arrCells
.Columns.AutoFit
End With
End With
End Sub
The resulting sheet is as follows: