亚马逊销售数据（Excel VBA）

Question

我试图获取我通过 Excel VBA 搜索的每个关键字的结果编号（在 HTML 代码中）。通过 className、id 和 data-asin 缩小标准，但最后一个被证明是棘手的，因为 VBA 还不支持该参考库。

这段代码的结构是做什么的：

转到 amazon.com 并转到搜索栏。
循环从 C 列开始。从 SearchTerm1 列中提取搜索词并进行搜索。
加载结果页面后，尝试通过类名、ID（均在 HTML 代码中找到）和 ASIN 编号（此编号从列中提取）查找指定产品B 为了匹配搜索结果页面上的 data-asin 值）。如果没有所有 3 个条件，excel 将无法找到列在第一个结果页面上的产品。
如果在第一页找到产品，则获取其结果位置（例如，第一个结果为 "result_0"，第二个结果为 result_1）并将其放入 D 列 (SRank1) .
如果未找到产品，循环将继续进行，直到搜索词列为空。
如果第一页没有找到该商品，则继续翻页搜索指定商品，以便抢到该商品的"search rank"。
对 SearchTerm2、3 和 4 列重复相同的步骤。

下面的截图是只根据className和ID条件拉取的代码，它从页面拉取了最后一个产品结果，这不是我分析产品表现的目的。

如果产品是搜索页面上的第一个结果，则包含的代码只会拉取产品排名，这意味着某些东西终于起作用了，但缺少一两步来从页面中获取所有产品位置。

任何帮助或推动正确的方向将不胜感激。我希望 VBA 能够更灵活地进行此类销售研究。到目前为止，它已经创造了奇迹，但我可能正在达到它的极限。代码如下。

Sub AmazonSearchRank()

    Dim MyHTML_Element As IHTMLElement
    Dim MyURL As String

    Dim AASearchRank As Workbook
    Dim AAws As Worksheet
    Dim InputSearchOrder As HTMLInputElement
    Dim elems As IHTMLElementCollection
    Dim TDelement As HTMLTableCell

    Dim InputSearchButton As HTMLInputButtonElement
    Dim IE As InternetExplorer
    Dim AASearchTerms As Workbook
    Dim SearchTermsSheet As Worksheet

    Dim x As Integer
    Dim i As Long

    MyURL = "https://www.amazon.com"
    Set IE = New InternetExplorer
    With IE
        .Silent = True
        .Navigate MyURL
        .Visible = True
        Do
            DoEvents
        Loop Until .ReadyState = READYSTATE_COMPLETE
    End With
    Set HTMLDoc = IE.Document

    Set AASearchRank = Application.Workbooks.Open("C:\Users\CompanyName\Desktop\Automation Anywhere\Sample_Items_For_SearchRank.xls")
    Set AAws = AASearchRank.Worksheets("Sheet1")

    Set InputSearchButton = HTMLDoc.getElementById("nav-search-submit-text")
    Set InputSearchOrder = HTMLDoc.getElementById("twotabsearchbox")
    If Not InputSearchOrder Is Nothing Then
        InputSearchButton.Click
        Do
            DoEvents
        Loop Until IE.ReadyState = READYSTATE_COMPLETE
    End If

    x = 2
    If AAws.Range("D" & x).Value = "" Then
        Do Until AAws.Range("B" & x) = ""
            Set InputSearchOrder = HTMLDoc.getElementById("twotabsearchtextbox")
            InputSearchOrder.Value = AAws.Range("C" & x)

            Set InputSearchButton = HTMLDoc.getElementsByClassName("nav-input")(0)
            InputSearchButton.Click
              Do
                DoEvents
            Loop Until IE.ReadyState = READYSTATE_COMPLETE
            Application.Wait (Now + TimeValue("0:00:05"))

            Set elems = HTMLDoc.getElementsByClassName("s-result-item celwidget")
            i = 2
            For Each TDelement In elems
                If TDelement.className = "s-result-item celwidget" And InStr(TDelement.ID, "result") InStr(TDelement.innerHTML, AAws.Range("B" & x).Value) Then
                    AAws.Range("D" & x).Value = TDelement.ID
                    i = i + 1
                End If
            Next
        x = x + 1
        Loop
    End If

End Sub

Answer 1

这里是为 sheet Terms 上显示的每个搜索查询从亚马逊下载产品并使用 ASIN 和描述填充 sheet Products 的示例。它使用 XHR，因此不需要 IE。代码如下：

Sub Test()
    lngRow = 1
    ' search each term
    For Each strTerm In Sheets("Terms").UsedRange
        lngPage = 1
        Do
            ' HTTP GET request of the search result page
            strUrl = "https://www.amazon.com/s/ref=nb_sb_noss_2?page=" & lngPage & "&keywords=" & EncodeUriComponent(strTerm)
            Set objXHR = CreateObject("MSXML2.XMLHttp")
            objXHR.Open "GET", strUrl, False
            objXHR.Send
            strResp = objXHR.ResponseText
            ' split response to array by items
            arrResp = Split(strResp, "<li id=""result_")
            ' process each item on the page
            For i = 1 To UBound(arrResp)
                strItem = arrResp(i)
                ' extract ASIN
                strTmp = Split(strItem, "data-asin=""")(1)
                strTmp = Split(strTmp, """")(0)
                Sheets("Products").Cells(lngRow, 1).NumberFormat = "@"
                Sheets("Products").Cells(lngRow, 1).Value = strTmp
                ' extract the product description
                strTmp = Split("<li id=""result_" & strItem, "</li>")(0) & "</li>"
                Sheets("Products").Cells(lngRow, 2).Value = GetInnerText(strTmp)
                ' show current item
                Sheets("Products").Cells(lngRow, 1).Select
                ' next row
                lngRow = lngRow + 1
            Next
            ' adjust sheet
            Sheets("Products").Columns.AutoFit
            Sheets("Products").Rows.AutoFit
            ' next page
            lngPage = lngPage + 1
        Loop Until UBound(arrResp) = 0 ' empty search result
    Next
End Sub

Function EncodeUriComponent(strText)
    Static objHtmlfile As Object
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
    End If
    EncodeUriComponent = objHtmlfile.parentWindow.encode(strText)
End Function

Function GetInnerText(strHtmlContent)
    Dim objHtmlFile, objBody
    Set objHtmlFile = CreateObject("htmlfile")
    objHtmlFile.write strHtmlContent
    Set objBody = objHtmlFile.getElementsByTagName("body")(0)
    GetInnerText = Trim(objBody.innerText)
End Function

我放在了Terms sheet:

Product sheet 的结果包含 571 项：

这不是一个完整的答案，但我希望它能帮助到你。

Answer 2

通过反复试验，我终于解决了这个血腥的事情。我只需要删除包含 "And InStr(TDelement.ID, "result")" 的部分代码，然后所有内容运行都像黄油一样光滑。

亚马逊销售数据（Excel VBA）

Amazon Sales Data (with Excel VBA)

excel

vba

xmlhttprequest

amazon-web-services

web-scraping