CODEWITHSUNDEEP
vbapost
Vsevolod S
Vsevolod S

Reputation: 11

VBA post request

I am trying to send a request for a specific store, but nothing comes out. Tell me, please, what not to do? The price for this should be 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

Upvotes: 1

Views: 575

Answers (2)

Cody Geisler
Cody Geisler

Reputation: 8617

Change your code to use 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

Your cookies aren't being set properly (checked this by comparing a response with one done in postman, another application that can make POST requests).

Unfortunately, it doesn't appear that XMLHTTP60 really allows you to set them, so use ServerXMLHTTP60 instead.

Upvotes: 1

SIM
SIM

Reputation: 22440

Why are you trying to send A "POST" request? Try sending "GET" request instead to collect the price you are after. Here is how you can do:

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

Output:

16 999руб.

When you wish to parse the product price of store 714, you need to send a POST request to this https://hoff.ru/ajax/get_delivery_price.php along with appropriate parameters. The FormData which should be passed with the POST request are huge. Moreover, there are some json content (within those parameters) which are a bit complicated to handle.

However, your best bet is to go for 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

Output:

 15 899руб.

Reference to add to the library:

Microsoft Internet Controls
Microsoft HTML Object Library

Upvotes: 2

Related Questions