VBA POST json to API - json

I am trying to write VBA to post json to an api and parse the results into a worksheet. I can generate the JSON and am confident I can parse the result into what I need.
I know there are online tools to convert json to vba and back and browser add ins to post requests but I am the only one in the office that can do this so if I'm sick or on leave I would like to automate it. To do that I need to send the json and maybe store the response so I can parse it.
I'm new to coding so posting a request like this is over my head.
So far I have the following code to write the json. I would appreciate any help in getting me started. If needed I can post a sample of the json or the api I would like to post it to.
Apologies for the poor code I know I can improve it but want to get the json response as I think it will be the most challenging part.
EDIT Have made some progress. Can now send a JSON string to the URL and get the response. However it is always returning a failure:
"{
""message"": ""An error has occurred.""
}"
If I manually send the json with httpRequestor the result is returned correctly.
This seems to suggest that somewhere in the code the JSON is getting mixed up or modified somehow when it is being posted.
Updated code below. (Have removed any reference to actual data)
EDIT 2 fixed and working.
Removed quotes from
objHTTP.send ("Json")
Private Sub CommandButton21_Click()
Dim h_1 As String
Dim h_2 As String
h_1 = Range("A1")
h_2 = Range("B1")
h_3 = Range("C1")
h_4 = Range("D1")
h_5 = Range("E1")
h_6 = Range("F1")
sv_1 = 2
sv_2 = 2
sv_3 = 2
sv_4 = 2
sv_5 = 2
sv_6 = 2
For f = 15 To 21
v_1 = Range("A" & sv_1)
v_2 = Range("B" & sv_2)
v_3 = Range("C" & sv_3)
v_4 = Range("D" & sv_4)
v_5 = Range("E" & sv_5)
v_6 = Range("F" & sv_6)
y = "[{""" & h_1 & """:""" & v_1 & """,""" & h_2 & """:""" & v_2 & """,""" & h_3 & """:""" & v_3 & """,""" & h_4 & """:""" & v_4 & """,""" & h_5 & """:""" & v_5 & """,""" & h_6 & """:""" & v_6 & """ }]"
Range("A" & f).Value = y
sv_1 = sv_1 + 1
sv_2 = sv_2 + 1
sv_3 = sv_3 + 1
sv_4 = sv_4 + 1
sv_5 = sv_5 + 1
sv_6 = sv_6 + 1
Next f
Dim objHTTP As Object
Dim Json As String
Json = Range("A15")
Dim result As String
'Set objIE = CreateObject("InternetExplorer.Application") ' Don't think this is needed
'objIE.navigate "about:blank" ' Don't think this is needed
'objIE.Visible = False ' Don't think this is needed
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URl = "http://myApi/iSendJsonTo"
objHTTP.Open "POST", URl, False
'objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/json"
objHTTP.send ("Json")
result = objHTTP.responseText
'objIE.document.Write result ' Don't think this is needed
'Some simple debugging
Range("A25").Value = result
Range("A26").Value = Json
Set objHTTP = Nothing

Here is the code that is sending the JSON, cleaned up a little.
Dim objHTTP As Object
Dim Json As String
Json = Range("A15") 'here I am pulling in an existing json string to test it. String is created in other VBA code
Dim result As String
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URl = "http://myApi/iSendJsonto/"
objHTTP.Open "POST", URl, False
objHTTP.setRequestHeader "Content-type", "application/json"
objHTTP.send (Json)
result = objHTTP.responseText
'Some simple debugging
Range("A25").Value = result
Range("A26").Value = Json
Set objHTTP = Nothing

Related

Parse JSON file using VBScript - QTP/UFT

I am using QTP/UFT for automating my UI application. I would like to compare the UI values with the values from the REST API response. I'm new to VBScript and I have coded the method to call the REST API and get the response but i'm trying to find a solution how to parse the JSON using VBScript.
Please help me how i could parse the json response? (Code below)
OR if it's easier to accept the REST response in xml and parse it in VBS?
Appreciate your help and ideas. Thanks!
userName = "abc#xyz.com"
password = "blah.123"
acctNumber = "01999994201"
URL1="https://CXaic-blah.blah.ocp.blah.com:243/ic/api/integration/v1/flows/rest/blah_ACCNTSEARCH/1.0/accountSearch?accountNumber="
URL=URL1&acctNumber
Set objXmlHttpMain = CreateObject("Msxml2.ServerXMLHTTP")
on error resume next
objXmlHttpMain.open "GET",URL, False , userName, password
objXmlHttpMain.setRequestHeader "Accept", "application/json"
objXmlHttpMain.setRequestHeader "charset", "UTF-8"
objXmlHttpMain.send
restjsonresp = objXmlHttpMain.responseText
Below is the format of the json response i get:
{
"searchResponse":{
"element":[
{
"accType":"R",
"accountNumber":"1111111",
"accountStatus":"A",
"taxId":""
}
]
}
}
While I don't have QTP/UFT to test or verify the following code, I offer-up these JSON parsing solutions as-is for experimentation...
1) Inject a JScript block into a "htmlfile" object
Dim y, html : Set html = CreateObject("htmlfile")
Dim window : Set window = html.parentWindow
window.execScript "var json=" & restjsonresp & ";var e=new Enumerator(json.searchResponse.element);", "JScript"
While Not window.e.atEnd()
Set y = window.e.item()
Print "acctType: " & y.accType
Print "accountNumber: " & y.accountNumber
Print "accountStatus: " & y.accountStatus
Print "taxId: " & y.taxId
window.e.moveNext
Wend
2) Calling JScript code using the "MSScriptControl.ScriptControl" (requires 32-bit)
Dim x, eng : Set eng = CreateObject("MSScriptControl.ScriptControl")
eng.Language = "JScript"
eng.AddCode "function json() { return " & restjsonresp & "; }"
Dim oResp : Set oResp = eng.Run("json")
For Each x In oResp.searchResponse.element
Print "acctType: " & x.accType
Print "accountNumber: " & x.accountNumber
Print "accountStatus: " & x.accountStatus
Print "taxId: " & x.taxId
Next
3) Injecting a JScript block into "InternetExplorer.Application" (overkill? perfomance hit)
Dim z, objIE : Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate2 "about:blank"
objIE.Toolbar = False
objIE.StatusBar = False
objIE.MenuBar = False
Do While objIE.Busy
Wait 1
Loop
objIE.Visible = False
objIE.document.open "text/html"
objIE.document.write "<script type='text/javascript'>document.json=" & restjsonresp & ";document.jsonEnum = new Enumerator(document.json.searchResponse.element);</script>"
objIE.document.close
While Not objIE.document.jsonEnum.atEnd()
Set z = objIE.document.jsonEnum.item()
Print "acctType: " & z.accType
Print "accountNumber: " & z.accountNumber
Print "accountStatus: " & z.accountStatus
Print "taxId: " & z.taxId
objIE.document.jsonEnum.moveNext
Wend
objIE.Quit
4) Using Demon's VbsJson object (a pure VBScript solution; albeit, with more code)
https://github.com/eklam/VbsJson
5) Use regular expressions (only for simple, well-defined JSON responses)
Dim re : Set re = New RegExp
re.IgnoreCase = True
re.Pattern = "\{\s*""searchResponse""\s*\:\s*\{\s*""element""\s*\:\s*\[\s*(\{\s*""accType""\s*\:\s*""(.*)""\s*,\s*""accountNumber""\s*\:\s*""(.*)""\s*,\s*""accountStatus""\s*\:\s*""(.*)""\s*,\s*""taxId""\s*\:\s*""(.*)""\s*\})\s*\]\s*\}\s*\}"
If re.Test(restjsonresp) Then
Dim matches : Set matches = re.Execute(restjsonresp)
Print "acctType: " & matches(0).SubMatches(1)
Print "accountNumber: " & matches(0).SubMatches(2)
Print "accountStatus: " & matches(0).SubMatches(3)
Print "taxId: " & matches(0).SubMatches(4)
End If
6) Convert JSON to XML, then parse the XML (lots of code, potential overkill)
https://github.com/pravynandas/JSONToXML
If you can control the response, and deliver XML instead of JSON, then it may be preferable to stick with XML for VBScript in QTP/UFT. Regardless, I hope something here is helpful.
Enjoy.

How to download and get values from JSON file using VBScript or batch file?

This is the VBScript code answered here to get the JSON file from computer with proper values.
Set fso = CreateObject("Scripting.FileSystemObject")
json = fso.OpenTextFile("C:\path\to\combined.json").ReadAll
Set re = New RegExp
re.Pattern = """passed"":(true|false),"
re.IgnoreCase = True
For Each m In re.Execute(json)
passed = CBool(m.SubMatches(0))
Next
But I have a JSON file that looks like this which is online,
["AA-BB-CC-MAKE-SAME.json","SS-ED-SIXSIX-TENSE.json","FF-EE-EE-EE-WW.json","ZS-WE-AS-FOUR-MINE.json","DD-RF-LATERS-LATER.json","FG-ER-DC-ED-FG.json"]
How to download this JSON file and get the values to five variables using either VBScript or batch file?
Here is an example for downloading a json from internet and parse it :
Dim http,URL
URL = "http://ip-api.com/json/"
Set http = CreateObject("Msxml2.XMLHTTP")
http.open "GET",URL,False
http.send
strJson = http.responseText
Set j = ParseJson(strJson)
Result = "IP =" & j.query & vbCrlf &_
"ISP = "& j.isp & vbCrlf &_
"Country = "& j.country & vbCrlf &_
"TimeZone = "& j.timezone
Wscript.echo Result
'--------------------------------------------------------
Function ParseJson(strJson)
Set html = CreateObject("htmlfile")
Set window = html.parentWindow
window.execScript "var json = " & strJson, "JScript"
Set ParseJson = window.json
End Function
'--------------------------------------------------------
You can give a try for this code :
Dim http,URL
URL = "https://privateURL/jsonfile/"
Set http = CreateObject("Msxml2.XMLHTTP")
http.open "GET",URL,False
http.send
strJson = http.responseText
Result = Extract(strJson,"(\x22(.*)\x22)")
Arr = Split(Result,",")
For each Item in Arr
wscript.echo Item
Next
'******************************************
Function Extract(Data,Pattern)
Dim oRE,oMatches,Match,Line
set oRE = New RegExp
oRE.IgnoreCase = True
oRE.Global = True
oRE.Pattern = Pattern
set oMatches = oRE.Execute(Data)
If not isEmpty(oMatches) then
For Each Match in oMatches
Line = Line & Trim(Match.Value) & vbCrlf
Next
Extract = Line
End if
End Function
'******************************************

Can VB6 "Stringify" JSON?

We have an application built in vb6 that needs a few functions to be re written in order to converse with our soon to be completed JSON API. The vb6 application previously communicating directly with one of our databases we are decommissioning.
Our API would be much happier if we could serialize query params to a string and send them in a query parameter via GET request
example:
https://my_api_url.com/resource?query=stringified_json_object
vb6 does not speak JSON natively and relies on libraries to give it some assistance, I can read JSON but how can I turn it back into a string?
Private Sub Receive(ByVal NewURL As String, NewData() As Byte)
Dim xmlhttp As MSXML2.ServerXMLHTTP
Set xmlhttp = New MSXML2.ServerXMLHTTP
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.Open "GET", NewURL, False
xmlhttp.setRequestHeader "Content-Type", "application/json; charset=utf-8"
xmlhttp.send
NewData = xmlhttp.responseBody
Set xmlhttp = Nothing
End Sub
Private Sub Send(ByVal NewURL As String, ByVal NewBlock As String)
Dim xmlhttp As MSXML2.ServerXMLHTTP
Set xmlhttp = New MSXML2.ServerXMLHTTP
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.Open "PUT", NewURL, True
xmlhttp.setRequestHeader "Content-Type", "application/json; charset=utf-8"
xmlhttp.send ("[" & NewBlock & "]")
Set xmlhttp = Nothing
End Sub
If you build the string in VB it will be something like this
AuxStr = AuxStr & "{"
'/----------------- CODE ------------------------------
AuxStr = AuxStr & """code"": " & """" & varCode & """"
'/------------- DESCRIPTION --------------------------
AuxStr = AuxStr & "," & """name"": " & """" & varName & """"
AuxStr = AuxStr & "}"
another option is to get json from a text file

how can I http post a JSON file using an excel on both Windows and Mac

I currently have a spreadsheet where a macro creates a JSON string and posts it to a web service using HTTP. On windows this code works fine for this:
Private Sub pvPostString(sUrl As String, sString As String, sFileName As String, Optional ByVal bAsync As Boolean)
Const STR_BOUNDARY As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
Dim nFile As Integer
Dim baBuffer() As Byte
Dim sPostData As String
Dim connUrl As String
sPostData = sString
'--- prepare body
sPostData = "--" & STR_BOUNDARY & vbCrLf & _
"Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
sPostData & vbCrLf & _
"--" & STR_BOUNDARY & "--"
'--- post
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", sUrl, bAsync
.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
.Send pvToByteArray(sPostData)
End With
End Sub
However on the latest Mac Excel I get an error "ActiveX component can't create object". This makes sense as MSXML2.XMLHTTP is a Microsoft solution, however it means I need to find a replacement function.
I've done lots of googling on this matter and from what I have read I may be able to achieve this using query tables. However, I have tried all sorts of configurations but with no joy. For example if I try the following then I get the error "Invalid web query"
With ActiveSheet.QueryTables.Add(Connection:=connUrl, Destination:=Range("C30"))
.PostText = myJSONString
.RefreshStyle = xlOverwriteCells
.SaveData = True
.Refresh
End With
This makes sense as JSON isn't valid post text, though at the same time posting a lengthy JSON file as post text doesn't really seem like the right solution.
Ideally I would like to post the JSON as a file so that it can be referenced on the server by $_FILES[]. Though from what I've read it isn't clear on how to do this (or if it is possible at all).
tldr; Ultimately my objective with this is to have a function that allows me to post a lengthy JSON string via http that will work on both Windows and Mac. I would really appreciate any help on this.
VBA-Web (previously Excel-REST) supports both Windows in Mac in v4.0.0 and allows you to GET, POST, PUT, PATCH, and DELETE from VBA. I haven't tried it with file uploads, so I'm not sure it will work in your case, but I'd give it a try. Here's a sample:
' Replace with the following
' With CreateObject("MSXML2.XMLHTTP")
' .Open "POST", sUrl, bAsync
' .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
' .Send pvToByteArray(sPostData)
' End With
' Client for executing requests
Dim Client As New WebClient
' Generally set Client.BaseUrl here, but it's not required
' Request for setting request details
Dim Request As New WebRequest
Request.Method = WebMethod.HttpPost
Request.Resource = sUrl
Request.ContentType = "multipart/form-data; boundary=" & STR_BOUNDARY
' Execute request and store response
Dim Response As WebResponse
Set Response = Client.Execute(Request)

Excel VBA macro using iTunes search API - fastest way to query & parse JSON results

I am trying to build Excel page from iTunes query data.
An example for Angry Birds app my query would look like:
https://itunes.apple.com/lookup?id=343200656&country=AL checking Albania iTunes
https://itunes.apple.com/lookup?id=343200656&country=DZ checking Algeria iTunes
... 150 more stores
My question is the most efficient way to do this query and parse response.
I only know how to to xmlhttp query. Please enlighten me as the better way to do this.
I have read some documentation for VB-JSON, Json.net, CDataSet, fastJSON, but cannot figure out how to get started trying those tools. Anyone have more VBA code examples pulling JSON or way to explain usage of these frameworks to a newb?
Dim innerHTML As Object
Dim myText As String
JsonCheck = ""
Set innerHTML = CreateObject("Microsoft.XMLHTTP")
With innerHTML
.Open "GET", iTunesAPI_link, False
.send
myText = .responsetext
End With
Set innerHTML = Nothing
If InStr(myText, ":0") = 20 Then 'no results found
result = "Down"
ElseIf InStr(myText, "Your request produced an error.") = 46 Then 'link error
result = HTMLCheck(human iTunes link)
Else 'found the app
result = call function which parses myText for desired fields
Endif
Here's a basic approach using the scriptcontrol:
Sub Tester()
Dim json As String
Dim sc As Object
Dim o
Set sc = CreateObject("scriptcontrol")
sc.Language = "JScript"
json = HttpGet("https://itunes.apple.com/lookup?id=343200656&country=AL")
'some json property names may be keywords in VBA, so replace with
' something similar....
json = Replace(json, """description""", """description_r""")
Debug.Print json
sc.Eval "var obj=(" & json & ")" 'evaluate the json response
'add some accessor functions
sc.AddCode "function getResultCount(){return obj.resultCount;}"
sc.AddCode "function getResult(i){return obj.results[i];}"
Debug.Print sc.Run("getResultCount")
Set o = sc.Run("getResult", 0)
Debug.Print o.kind, o.features, o.description_r
End Sub
Function HttpGet(url As String) As String
Dim oHTML As Object
Set oHTML = CreateObject("Microsoft.XMLHTTP")
With oHTML
.Open "GET", url, False
.send
HttpGet = .responsetext
End With
End Function
There's a worked-out approach in Codo's answer to this question: Excel VBA: Parsed JSON Object Loop
I had a similar issue with querying Salesforce's REST API and found dealing with JSON through ScriptControl ended up being unmanageable. I used the following library for parsing and converting to JSON and it's worked perfectly for me: https://code.google.com/p/vba-json/.
Dim JSON As New JSONLib
Dim Parsed As Object
Set Parsed = JSON.parse(jsonValue)
Debug.Print Parsed("resultCount")
Debug.Print Parsed("results")(0)
Using that library, I then wrapped up some of the common functionality for making web requests that I think would help you out: https://github.com/timhall/Excel-REST
Using these libraries, your code would look something like the following:
Dim iTunesClient As New RestClient
iTunesClient.BaseUrl = "https://itunes.apple.com/"
Dim Request As New RestRequest
Request.Format = json
Request.Resource = "lookup"
Request.AddQuerystringParam "id", "343200656"
Request.AddQuerystringParam "country", "AL"
Dim Response As RestResponse
Set Response = iTunesClient.Execute(Request)
' => GET https://itunes.apple.com/lookup?id=343200656&country=AL
If Response.StatusCode = 200 Then
' Response.Data contains converted JSON Dictionary/Collection
Debug.Print "Result Count: " & Response.Data("resultCount")
Dim i As Integer
For i = LBound(Response.Data("results")) To UBound(Response.Data("results"))
Debug.Print "Result " & i & ": " & Response.Data("results")(i)
Next i
Else
Debug.Print "Error: " & Response.Content
End If