Question

我正在尝试发送特定商店的请求，但没有任何结果。请告诉我，不该做什么？这个价格应该是15 899。

Sub Macros1()
Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim name As String
XMLPage.Open "POST", "https://hoff.ru/catalog/?articul=80295933", False
XMLPage.setRequestHeader "User -Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/63.0.3239.132 Safari/537.36"
XMLPage.setRequestHeader "Host", "hoff.ru:443"
XMLPage.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
XMLPage.setRequestHeader "Cookie", "current_location_id=1780"
XMLPage.setRequestHeader "Cookie", "current_city=714"
XMLPage.send
HTMLDoc.body.innerHTML = XMLPage.responseText
name = HTMLDoc.getElementsByClassName("product-new-price")(0).innerText
Cells(4, 1) = name
End Sub

Answer 1

您为什么要发送“POST”请求？尝试发送“GET”请求以收集您所追求的价格。您可以这样做：

Sub Fetch_Price()
    Dim HTTP As New XMLHTTP60, HTML As New HTMLDocument
    Dim post As Object

    With HTTP
        .Open "GET", "https://hoff.ru/catalog/?articul=80295933", False
        .send
        HTML.body.innerHTML = .responseText
    End With

    Set post = HTML.getElementsByClassName("product-new-price")(0)
    [A1] = post.innerText
End Sub

输出：

16 999руб.

如果您希望解析store 714的产品价格，则需要向此POST发送https://hoff.ru/ajax/get_delivery_price.php个请求以及相应的参数。应该与FormData请求一起传递的POST是巨大的。此外，还有一些json内容（在这些参数中），处理起来有点复杂。

然而，你最好的选择是去InternetExplorer：

Sub Fetch_Price()
    Dim IE As New InternetExplorer, HTML As HTMLDocument
    Dim post As Object, elem As Object

    With IE
        .Visible = True
        .navigate "https://hoff.ru/catalog/?articul=80295933"
        While .Busy = True Or .readyState < 4: DoEvents: Wend
        Set HTML = .document
    End With

    Do: Set post = HTML.getElementsByClassName("header-city-name j_header_city_name")(0): DoEvents: Loop While post Is Nothing
    post.Click

    HTML.getElementById("city-714").Click
    Do: Set elem = HTML.getElementsByClassName("product-new-price")(0): DoEvents: Loop While elem Is Nothing

    [A1] = elem.innerText

    IE.Quit
End Sub

输出：

 15 899руб.

参考添加到库：

Microsoft Internet Controls
Microsoft HTML Object Library

Answer 2

更改您的代码以使用ServerXMLHTTP60。

Sub Macros1()
Dim XMLPage As New MSXML2.ServerXMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim name As String
XMLPage.Open "POST", "https://hoff.ru/catalog/?articul=80295933", False
XMLPage.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/63.0.3239.132 Safari/537.36"
XMLPage.setRequestHeader "Host", "hoff.ru:443"
XMLPage.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
XMLPage.setRequestHeader "Cookie", "current_location_id=1780"
XMLPage.setRequestHeader "Cookie", "current_city=714"
XMLPage.send
HTMLDoc.body.innerHTML = XMLPage.responseText
name = HTMLDoc.getElementsByClassName("product-new-price")(0).innerText
Cells(4, 1) = name
End Sub

您的Cookie未正确设置（通过将响应与邮递员中的响应进行比较来检查，另一个可以发出POST请求的应用程序）。

不幸的是，XMLHTTP60似乎并不允许您设置它们，因此请使用ServerXMLHTTP60。

VBA发布请求

2 个答案: