Using Excel VBA code to send a POST and retrieve data - excel

What VBA code would allow me to send a POST request (in a asp search box) and then to retrieve data between a <span id="xxx"></span> tag? (in the resulting page)
I have the following code that simulates a search request in the page:
Dim Site As Object
Set Site = CreateObject("InternetExplorer.application")
Dim QNUMBER As String
Dim URL As String
URL = "apps/inventory/Default.aspx" 'local website
QNUMBER = textBox_Scan.Text
Site.navigate URL
While Site.busy
Wend
Dim oHTMLDoc As Object
Set oHTMLDoc = Site.document
oHTMLDoc.getElementById("input_search").Value = QNUMBER
oHTMLDoc.getElementById("btn_search").Click
It doesnt feel "clean" to do it that way and I feel that sending a POST request would be more appropriate.
Thanks.
[edit]
This is the form code
<form name="aspnetForm" method="post" action="Default.aspx" id="aspnetForm">
The input text id
id="input_search"
The submit button code
id="btn_search"
and I'd like to get data from <span id="warranty">36 month</span> and <span id="budget">500$</span>

Sub macroPOST()
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = "[Your URL]"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.Send ("id=dddaaa&pwd=1234[Your request parameters]")
replyTXT = objHTTP.responseText
If objHTTP.Status = "200" Then 'success
MsgBox replyTXT
Else
'Do something
End If
End Sub
It works on my Excel, thank you for reading carefully.

Related

Excel VBA API Request

So I don't have any experience coding whatsoever but I'm working on pulling some vehicle data from an government site with an API using VBA. so i don't have to manually adjust data in our vehicle list.
the code i wrote/stole:
Sub SendAPIRequest()
Dim httpreq As Object
Dim url As String
Dim response As String
Dim headers As Collection
Set headers = New Collection
headers.Add "SVV-Authorization", "Apikey {1234}"
Set httpreq = CreateObject("MSXML2.XMLHTTP")
url = "https://www.vegvesen.no/ws/no/vegvesen/kjoretoy/felles/datautlevering/enkeltoppslag/kjoretoydata?kjennemerke=AA91620" + kjennemerke
With httpreq
.Open "GET", url, False
.setRequestHeader "SVV-Authorization", "1234}"
.send
End With
response = httpreq.responseText
Debug.Print response
End Sub
the request goes out but the with the following response: "status":403,"error":"Forbidden","path":"/enkeltoppslag/kjoretoydata"}
403 The API key does not exist in the database, has the status active and/or the user is blocked.
Additional info: REST service - Json response.
https://autosys-kjoretoy-api.atlas.vegvesen.no/api-ui/index-enkeltoppslag.html
key is legit so I'm sending the header out wrong?
Thanks in advance :)
copy & paste other code, etc.

Can MSXML2.XMLHTTP be used with Chrome

I have been using the following Excel VBA macro to bring back data from a website. It worked fine until a few days ago when the website stopped supporting IE. Of course the macro just fails now as there is no data on the webpage to bring back to Excel, just a message saying, "Your browser, Internet Explorer, is no longer supported." Is there a way to have the "Get method" (MSXML2.XMLHTTP) use Chrome instead of IE to interact with the website? BTW, my default browser is already set to "Chrome".
Dim html_doc As HTMLDocument ' note: reference to Microsoft HTML Object Library must be set
Sub KS()
' Define product url
KS_url = "https://www.kingsoopers.com/p/r-w-knudsen-just-blueberry-juice/0007468210784"
' Collect data
Set html_doc = New HTMLDocument
Set xml_obj = CreateObject("MSXML2.XMLHTTP")
xml_obj.Open "GET", KS_url, False
xml_obj.send
html_doc.body.innerHTML = xml_obj.responseText
Set xml_obj = Nothing
KS_product = html_doc.getElementsByClassName("ProductDetails-header")(0).innerText
KS_price = "$" & html_doc.getElementsByClassName("kds-Price kds-Price--alternate mb-8")(1).Value
do Stuff
End Sub
The check for this is a basic server check on user agent. Tell it what it wants to "hear" by passing a supported browser in the UA header...(or technically, in this case, just saying the equivalent of: "Hi, I am not Internet Explorer".)
It can be as simple as xml.setRequestHeader "User-Agent", "Chrome". I said basic because you could even pass xml.setRequestHeader "User-Agent", "I am a unicorn", so it is likely an exclusion based list on the server for Internet Explorer.
Option Explicit
Public Sub KS()
Dim url As String
url = "https://www.kingsoopers.com/p/r-w-knudsen-just-blueberry-juice/0007468210784"
Dim html As MSHTML.HTMLDocument, xml As Object
Set html = New MSHTML.HTMLDocument
Set xml = CreateObject("MSXML2.XMLHTTP")
xml.Open "GET", url, False
xml.setRequestHeader "User-Agent", "Mozilla/5.0"
xml.send
html.body.innerHTML = xml.responseText
Debug.Print html.getElementsByClassName("ProductDetails-header")(0).innerText
Debug.Print "$" & html.getElementsByClassName("kds-Price kds-Price--alternate mb-8")(1).Value
Stop
End Sub
Compare that with adding no UA or adding xml.setRequestHeader "User-Agent", "MSIE".
Study the article here by Daniel Pineault and this paragraph:
Feature Browser Emulation
Also note my comment dated 2020-09-13.

Scrape data that is not in the source code, using VBA

I'm trying to scrape whole div from one website. The data is not visible in the source code, it changes based on the variable in the URL (link).
I was looking for any solution to copy to the excel sheet everything from
<div id="div_measures_for_2103909010" class="measures_detail">
Unfortunately since there is no data in direct source code I have found a way to display only data from the div provided above Link
However to get this data I would need at first get the link to the direct data (the link is in the source code).
Do you have any idea how to deal with it the best possible way?
I've tried to download the source code, search for the link, open the link and copy all the data, but I have troubles downloading the source code (excel downloads only part of it due to cell data limitations). Here is my current code:
Sub Open_Webpage()
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = "https://ec.europa.eu/taxation_customs/dds2/taric/measures.jsp?Lang=en&SimDate=20190329&Area=&MeasType=&StartPub=&EndPub=&MeasText=&GoodsText=&op=&Taric=2103909010&search_text=goods&textSearch=&LangDescr=pl&OrderNum=&Regulation=&measStartDat=&measEndDat="
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
html = objHTTP.responseText
Range("A1").Value = html
End Sub
If I am able to have full code in one cell I can then look for the link in the source code and use it:
=MID(LEFT(A1,FIND("' width='100%'",A1)-1),FIND("' src='",A1)+7,LEN(A1))
I know that there must be some better solution, but I'm not so proficient in VBA to figure it out...
You can regex out the required url, do a little cleaning then pass on to xhr. For some reason I was unable to simply use getAttribute("onclick") so had to use outerHTML (innerHTML also fine) on the element
Option Explicit
Public Sub GetInfo()
Dim html As HTMLDocument, s As String, re As Object, url As String
Set re = CreateObject("vbscript.regexp")
Set html = New HTMLDocument '< VBE > Tools > References > Microsoft Scripting Runtime
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://ec.europa.eu/taxation_customs/dds2/taric/measures.jsp?Lang=en&SimDate=20190329&Area=&MeasType=&StartPub=&EndPub=&MeasText=&GoodsText=&op=&Taric=2103909010&search_text=goods&textSearch=&LangDescr=pl&OrderNum=&Regulation=&measStartDat=&measEndDat=", False
.send
html.body.innerHTML = .responseText
s = html.querySelector("[id$='_end_goods']").outerHTML
With re
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = "measures_details\.jsp(.*)'\);"
If .Test(s) Then
url = "https://ec.europa.eu/taxation_customs/dds2/taric/measures_details.jsp" & .Execute(s)(0).SubMatches(0)
url = Replace$(url, "&", "&")
End If
End With
If Len(url) > 0 Then
.Open "GET", url, False
.send
html.body.innerHTML = .responseText
ActiveSheet.Cells(1, 1) = html.querySelector(".measures_detail").innerText
End If
End With
End Sub
Try the regex here
References:
VBE > Tools > References > Microsoft HTML Object Library

Excel Web Query Object and Cookies: Is there a better way?

I have a HTML web page at work that I want to query data from tables into excel 2007. This web page requires I sign on with a password. I sign in with my normal IE7 browser, then I go to DATA -> connections -> my connections and edit the query. This reads the IE7 cookie cache and I re-POST the data to connect to the server's security by clicking "retry" when it says "the web query returned no data". After I do this, the data imports fine.
I can do this just fine and it only needs to be done once a day. Other users of my application find this difficult which leads to my question:
Is there a way to automatically POST this data back with VB? I'm thinking maybe I should use the cookie property of the IE.Document.cookie?
I'm calling the following login script, before I continue with the web query (set reference to XML library). Look around to find some instructions how you can find your POST parameters.
Sub XMLHttpLogin()
Dim i As Integer
Dim sExpr As String
Dim sPar As String, sURL as String
Dim sResp As String
Dim XMLHttp As MSXML2.XMLHTTP60
Set XMLHttp = New MSXML2.XMLHTTP60
sPar = "name=user1&pass=pass1&form_id=form1" 'The parameters to send.
sURL = "http://www.stackoverflow.com"
With XMLHttp
.Open "POST", sURL, True 'Needs asynchronous connection
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (sPar)
i = 0 'wait until data has been downloaded
Do While i = 0
If .readyState = 4 Then
If .Status = 200 Then Exit Do
End If
DoEvents
Loop
sResp = .responseText 'contains source code of website
sExpr = "not-logged-in" 'look for this string in source code
If InStr(1, sResp, sExpr, vbTextCompare) Then
MsgBox "Not logged in. Error in XMLHttpLogin"
End If
End With
End Sub

Excel VBA using XMLHTTP with Siteminder Secured site

I am completely new to using XMLHTTP and experimenting with trying to download a report off of our company's internet site using Excel VBA. The problem I seem to be running into is that the site is protected by Siteminder. I think I need to use an XMLHTTP.Open with GET but anyway I try all I just seem to get is the Siteminder HTML code. So I am trying to first use a post to send my username and password to Siteminder something like:
Function PostXmlData(vUrl As String, UserName As String, Password As String, xmlText
As String
Dim XMLHttp As Object
Set XMLHttp = CreateObject("MSXML2.XMLHTTP")
XMLHttp.Open "POST", vUrl, False, UserName, Password
XMLHttp.setRequestHeader "Content-Type", "text/xml;charset=utf-8"
XMLHttp.send (xmlText)
PostXmlData = XMLHttp.responseText
End Function
Sub Posttest ()
Dim add As String
Dim User As String
Dim Pass As String
Dim send As String
Dim ret As Variant
add = "https://mycompanywebsite.com/apps/application/Main/"
User = "username"
Pass = "password"
Send="DashboardId=http://mycompanywebsite.com/DAVCatalog/Dashboards/Teams/Client%20_
Extranet%20AM"
ret = PostXmlData(add, User, Pass, send)
End Sub
Am I on the right track or is this not even possible? Any suggestions would be greatly appreciated or if there is some site someone could direct me to that would be helpful. THanks.
You'll need to load the responseText into an XMLDocument so that you can parse it. See example below (make sure you add the Microsoft XML reference to the reference library)
Dim xmldoc As MSXML2.DOMDocument
' Create a new XMLDocument to which to load the XML text
Set xmlDoc = New DOMDocument
xmldoc.LoadXML (xmlhttp.responseText)
' Fetch the XML
Set xmlhttp = CreateObject("Microsoft.xmlHTTP")
xmlhttp.Open "Get", yourURL, False
xmlhttp.send
' Create a new XMLDocument to which to load the XML text
Set xmlDoc = New DOMDocument
xmldoc.LoadXML (xmlhttp.responseText)
From here, you should be able to parse the XML using objects like NodeList, DOMElement, etc.
Could you post the SiteMinder HTML response? Looks like authentication may be failing. Try sending the credentials as a base64 encoded header instead of supplying them to the XMLHttp componet.
This is the format.
Authorization: Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==
The string after 'Basic' is base64 encoded credentials in the 'id:password' format.

Resources