Excel VBA using XMLHTTP with Siteminder Secured site - excel

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.

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.

How to get specific data from a tag from XML page?

I have the following code to get the response text from an XML page, but it returns everything in the page:
Private Sub Testing()
Dim xmlhttp As New MSXML2.XMLHTTP60, myurl As String
myurl = "http://schemas.xmlsoap.org/soap/envelope/"
xmlhttp.Open "GET", myurl, False
xmlhttp.send
newstring = xmlhttp.responseText
Sheet1.Range("B2") = newstring
End Sub
The URL in myurl is for example only. The URL i'm trying to get is in an intranet site but this has a similar structure.
The following FIELD tag is not available in the URL above. I used the url as an example to show the type of document.
Let's say there's a tag like below in the middle of the page:
<FIELD NAME="str2">097cf4a8-2755-4c62-939c-9402e0a4e3e2</FIELD>
How do I get only this "097cf4a8-2755-4c62-939c-9402e0a4e3e2"? The str2 is unique.
Here is an example using a publicly available document. The principle of selecting by combination of tag and attribute value is shown.
Option Explicit
Public Sub Testing()
Dim xmlhttp As New MSXML2.XMLHTTP60, myurl As String
myurl = "http://www.chilkatsoft.com/xml-samples/bookstore.xml"
xmlhttp.Open "GET", myurl, False
xmlhttp.send
Dim xmlDoc As New MSXML2.DOMDocument60
Set xmlDoc = New MSXML2.DOMDocument60
xmlDoc.LoadXML xmlhttp.responseText
Debug.Print xmlDoc.SelectSingleNode("//userComment[#rating=""3""]").Text
End Sub
Source:
Output:

Using Excel VBA code to send a POST and retrieve data

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.

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

Resources