Amazon FBA ofrece extracción usando VBA

excel-vba web-scraping

Question

Estoy usando el código mencionado a continuación para extraer datos de 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

El código anterior está extrayendo datos completos de la página, pero Mi requisito es extraer el valor específico de los datos incompletos. Solo deseo extraer los precios y los precios de las páginas están en este formato.

<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>

Ayude a resolver este problema para poder extraer solo los precios. Deseo extraer dos valores, por ejemplo, $ 171.99 y Amazon Prime TM. Tenga en cuenta que existen varios valores de precio y vendedor en una página y deseo extraerlos todos.

Answer 1

Aquí hay un ejemplo que muestra cómo puede recuperar las ofertas de Amazon para ciertos ASIN utilizando XHR y Split , y los resultados de salida a la hoja:

Sub TestExtractAmazonOffers()
Dim arrList() As Variant
'' clear sheet
Sheets("Sheet1").Cells.Delete
'' retrieve offers for certain ASIN
arrList = ExtractAmazonOffers("B00N41UTWG")
'' output data
Output Sheets(1), 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 = "http://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 = "http://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

La hoja resultante es la siguiente: