I am using an API. I have credentials. It returns XML instead of JSON.
Sub usbRequest()
Dim objRequest As MSXML2.XMLHTTP60
Dim strURL As String
Set objRequest = New MSXML2.XMLHTTP60
strURL = "https://someAPIURL.com/"
objRequest.Open "GET", strURL, True, "MyUserName", "MyPassword"
objRequest.setRequestHeader "Content-Type", "application/json"
objRequest.send
While objRequest.readyState <> 4
DoEvents
Wend
Debug.Print objRequest.responseText
End Sub
The API Documentation indicates that an Accept header specifying JSON should return JSON. I do have a reference set to Microsoft XML V 6.0.
I had a macro that used to go to a website pull a value from the A column, for example 517167000, from a particular part of the code and returning that value to a cell.
The html source has changed now and i cant seem to get it to work.
My original code was
Public Function UnitPerBox(searchTerm As String) As String
Static request As Object
If request Is Nothing Then Set request = CreateObject("msxml2.xmlhttp")
With request
.Open "GET", "https://larsonjuhl.co.uk/mouldings/larson-juhl-essentials/arq-essentials-moulding-" & searchTerm, False
.send
UnitPerBox = Trim(Split(Split(.responseText, "Units per box</td>")(1), "<tr")(0))
End With
End Function
So a working example of the website is
https://larsonjuhl.co.uk/mouldings/larson-juhl-essentials/arq-essentials-moulding-517167000
So that you can go to the website and view the source.
The new html code looks like the below, but its been so long since i did the original macro, that i assumed that i could change
"Units per box</td>")(1), "<tr"
to
"Units per pack</td> <td class="value">")(1), "<tr"
as the below new html code is what is now on the site, and i need the value 2.74 for example, but its not working.
<tr>
<td class="name">Units per pack</td>
<td class="value">2.74</td>
</tr>
Any help would be much appreciated.
An example of
Cheers
If you go and work with .responseText using Split() doing text manipulation you might as well use a regular expression without setting it's Global parameter:
Public Function UnitPerBox(searchTerm As String) As String
Static request As Object
If request Is Nothing Then Set request = CreateObject("msxml2.xmlhttp")
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Pattern = "\d+(?:\.\d+)?"
With request
.Open "GET", "https://larsonjuhl.co.uk/mouldings/larson-juhl-essentials/arq-essentials-moulding-" & searchTerm, False
.send
UnitPerBox = RegEx.Execute(Split(.responsetext, "Units per pack</td>")(1))(0)
End With
End Function
Neater (IMO) however is to avoid text manipulation on the .responseText alltogether and work through the HTML document, retrieve the appropriate data straigt from the HTML-table by element-ID and table indexes:
Public Function UnitPerBox(searchTerm As String) As String
Static request As Object
If request Is Nothing Then Set request = CreateObject("msxml2.xmlhttp")
Dim htmlResponse As Object: Set htmlResponse = CreateObject("htmlfile")
With request
.Open "GET", "https://larsonjuhl.co.uk/mouldings/larson-juhl-essentials/arq-essentials-moulding-" & searchTerm, False
.send
htmlResponse.body.innerHTML = .responseText
UnitPerBox = htmlResponse.body.document.getElementById("specifications").getElementsByTagName("tr")(10).getElementsByTagName("td")(1).innerText
End With
End Function
Note that the table is 0-indexed meaning we are actually retrieving our value from the 11th row, second column. In case you are not sure that the tablecontent is always found on the same indexes, you could also just loop the child nodes:
Public Function UnitPerBox(searchTerm As String) As String
Static request As Object
If request Is Nothing Then Set request = CreateObject("msxml2.xmlhttp")
Dim htmlResponse As Object: Set htmlResponse = CreateObject("htmlfile")
Dim Rws As Object
With request
.Open "GET", "https://larsonjuhl.co.uk/mouldings/larson-juhl-essentials/arq-essentials-moulding-" & searchTerm, False
.send
htmlResponse.body.innerHTML = .responseText
Set Rws = htmlResponse.body.document.getElementById("specifications").getElementsByTagName("tr")
For Each Rw In Rws
If Rw.getElementsByTagName("td")(0).InnerText = "Units per pack" Then
UnitPerBox = Rw.getElementsByTagName("td")(1).InnerText
Exit For
End If
Next
End With
End Function
Where I personally would prefer to use HTML document over text manipulation, all above options work to retrieve your value =)
Public Sub IMPORTMESTER()
Dim xTOK As String
Dim URL As String
Dim httpREQ As Object
Dim JSON As Object
Dim xLINE As Variant
xTOK = "bdj62bzknriy3dd9g561on2xl2"
URL = "https://api.smartsheet.com/2.0/sheets/7352150637471620"
Set httpREQ = CreateObject("MSXML2.XMLHTTP.6.0")
With httpREQ
.Open "GET", URL, False
.setRequestHeader "Authorization", "Bearer " & xTOK
.setRequestHeader "Content-Type", "application/json"
.Send
End With
xLINE = httpREQ.ResponseText
MsgBox ("Complete!")
End Sub
So, Ive returned data I need, but I tried several methods to parse it and paste in excel, but without success. Here is the part of responsetext:
"cells":[{"columnId":2400415921792900,"value":"MWP08","displayValue":"MWP08"},{"columnId":6904015549163396,"value":"A-WP-80301D5D10C00","displayValue":"A-WP-80301D5D10C00"},{"columnId":1274516014950276,"value":"MWP0830W27V50KD","displayValue":"MWP0830W27V50KD"},{"columnId":5778115642320772,"value":"WP08 30W,120-277VAC,Ra70 5000K Clear lens,Dark bronze","displayValue":"WP08 30W,120-277VAC,Ra70 5000K Clear lens,Dark bronze"},{"columnId":3526315828635524,"value":"image002.png","displayValue":"image002.png","formula":"=SYS_CELLIMAGE(\"image002.png\",\"vDOY-InMRamvhitNGotKzb\",35,52,\"image.png\")","image":{"id":"vDOY-InMRamvhitNGotKzb","height":35,"width":52,"altText":"image002.png"}},{"columnId":8029915456006020},{"columnId":711566061528964,"value":1884.0,"displayValue":"1884","linkInFromCell":{"status":"INACCESSIBLE","sheetId":4533800614029188,"rowId":null,"columnId":null,"sheetName":"MLC-Inventory扣减(2019)"}},{"columnId":2963365875214212,"value":"https://mesterleds.com/wp-content/uploads/2017/12/WP01-45W70W.png","displayValue":"https://mesterleds.com/wp-content/uploads/2017/12/WP01-45W70W.png"},{"columnId":7466965502584708},{"columnId":1837465968371588},{"columnId":6341065595742084},{"columnId":4089265782056836},{"columnId":8592865409427332},{"columnId":430091084818308,"value":175.0,"displayValue":"175"},{"columnId":4933690712188804},{"columnId":2681890898503556},{"columnId":7185490525874052},{"columnId":1555990991660932},{"columnId":6059590619031428}]},{"id":7080298036914052,"rowNumber":3,"siblingId":2576698409543556,"expanded":true,"createdAt":"2019-01-31T00:06:35Z","modifiedAt":"2019-02-18T16:56:50Z",
Each row of table I need starts with:"cells';[{" while I only need "displayValue": for columns!
I tried several solutions and suggestions from various threads from StackOverflow but... no luck!
Below is desired output:
Final excel format (unneccessary columns hidden)
If only after displayValue you can use the following with jsonconverter.bas. You add the .bas to your project and then VBE > Tools > References> Add a reference to Microsoft Scripting Runtime.
Option Explicit
Public Sub IMPORTMESTER()
Dim xTOK As String
Dim URL As String
Dim httpREQ As Object
Dim json As Object
Dim xLINE As Variant
xTOK = "token"
URL = "https://api.smartsheet.com/2.0/sheets/7352150637471620"
Set httpREQ = CreateObject("MSXML2.XMLHTTP.6.0")
With httpREQ
.Open "GET", URL, False
.setRequestHeader "Authorization", "Bearer " & xTOK
.setRequestHeader "Content-Type", "application/json"
.send
End With
xLINE = httpREQ.responseText
Set json = JsonConverter.ParseJson(xLINE)("rows")
Dim item As Object, nextitem As Object, i As Long
For Each item In json
For Each nextitem In item("cells")
i = i + 1
ActiveSheet.Cells(i, 1) = nextitem("displayValue")
Next
Next
End Sub
The item you want is nested within the json where {} is a dictionary, and [] is a collection.
I'm trying to setup a API request to pull data from the Bureau of Labor Statistics. I succeeded in getting data using a get request, entering just the url and the series (as shown in the first code example). This works fine and I was able to parse out the JSON using Tim Hall's VBA-JSON converter and work with the data. My problem is that the get method returns only 3 years of data and I'd like to get more than that which requires a post method.
Sub GetCPItable()
Dim objhttp As Object
Dim strUrl As String
strUrl = "https://api.bls.gov/publicAPI/v1/timeseries/data/CUUR0000SA0"
Set objhttp = CreateObject("MSXML2.XMLHTTP")
With objhttp
.Open "get", strUrl, False
.Send
End With
MsgBox objhttp.ResponseText
End Sub
It seems (take this with a grain of salt, this is my first time working with api servers) like VBA is not passing my payload. I've checked my payload here and the JSON syntax appears correct and seems to be the correct syntax according to the page I first linked to. Yet the only things I recieve back from the api server is 404 not found errors. I've been trying different things to piece together what I'm missing all day from their source code examples (no VBA ofcourse) and posts here and elsewhere on the web and haven't made any progress. Here is a debugging version of the code that isn't working.
Sub GetCPItable()
Dim objhttp As Object
Dim body As String
'create our URL string and pass the user entered information to it
Dim strUrl As String
strUrl = "https://api.bls.gov/publicAPI/v1/timeseries/data"
Set objhttp = CreateObject("MSXML2.XMLHTTP")
With objhttp
.Open "POST", strUrl, False
.SetRequestHeader "Content-type", "application/json"
body = "{""seriesid"":""CUUR0000SA0""],""startyear"":""2008"",""endyear"":""2012""}"
.Send (body)
End With
MsgBox objhttp.ResponseText
End Sub
This is the error I get in response:
: responseText : "{
"status": "REQUEST_FAILED",
"responseTime": 0,
"message": [
"404 Error - Page Not Found"
],
"Results": [ ]
}" : String
Any help would be much appreciated. The only thing I can think to try next is using the V2 API but I'd like to avoid that if possible since it would require yearly reregistration.
I am attempting to send a POST URL message from MS Access VBA. When I attempt to run the code, it tells me that is not able to compile the following statement. Does anyone have any idea where I am incorrect in my syntax? Thank you in advance for assistance.
objHTTP.Open "POST", "http://kt1.com/apiv2/Configuration.asmx", False
The full code is:
Private Sub newKT_WebService_Click()
Dim objHTTP As String
Dim replyTXT As String
Dim AuthCode As String
objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.Open "POST", "http://kt1.com/apiv2/Configuration.asmx", False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.send ("CallingID=12345&token=%20&domain=%20&userName=testuser&password=testpassword")
MsgBox objHTTP.responseText
End Sub
objHTTP was declared as String. But later the code attempts to assign an object reference to it. So declare objHTTP as Object. And you must use the Set keyword to assign to the object variable.
Dim objHTTP As Object
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.Open "POST", "http://kt1.com/apiv2/Configuration.asmx", False
I'm not really familiar with MSXML2.ServerXMLHTTP but hopefully those changes will allow the code to compile and do what you need.