I know this is similar to some previously asked questions, but something is still not working for me. How can the following command:
curl -X POST --data #statements.json -H "Content-Type: application/json" --user username:password -H "x-experience-api-version: 1.0.0" https://MYLRS.waxlrs.com/TCAPI/statements
be replicated in VBA?
Extra Information:
This relates to a Hosted TIN CAN (xAPI) Learning Record Store called WaxLRS (by SaltBox). The above example comes from here:
http://support.saltbox.com/support/solutions/articles/1000083945-quick
I have an account (free tinkerers account, no CC required to setup) and have generated what I believe to be the required username & password combination. The credentials are termed 'Identifier' & 'Password' and appear under a heading: Basic Authentication Credentials.
No matter what I do I get an error message:
<html>
<head><title>Unauthorized</title></head>
<body>
<h1>Unauthorized</h1>
<p>This server could not verify that you are authorized to
access the document you requested. Either you supplied the
wrong credentials (e.g., bad password), or your browser
does not understand how to supply the credentials required.
<br/>
<!-- --></p>
<hr noshade>
<div align="right">WSGI Server</div>
</body>
</html>
I believe that the example is expecting the JSON payload to be obtained from a file, but I am loading it into a string. I don't expect this to be contributing to the problem, I have compared my string with the example provided using NP++ Compare and it matches.
My code so far is:
url = "https://xxxxxxx.waxlrs.com/TCAPI/statements"
Set pXmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1") 'MSXML2.XMLHTTP")
pXmlHttp.Open "POST", url, False
pXmlHttp.setRequestHeader "Content-Type", "application/json"
'pXmlHttp.setRequestHeader "Authorization", "Basic xxxxxxt8wfB6JYerYCz:xxxxxx1FOd29J1s6G2"
pXmlHttp.SetCredentials "xxxxxxt8wfB6JYerYCz", "xxxxxx1FOd29J1s6G2", 0
pXmlHttp.setRequestHeader "x-experience-api-version", "1.0.0"
pXmlHttp.send (stringJSON)
Set pHtmlObj = CreateObject("htmlfile")
pHtmlObj.body.innerHTML = pXmlHttp.responseText
apiWaxLRS = pXmlHttp.responseText
Questions/Answers that helped:
Send a JSON string to a RESTful WS from Classic ASP
https://stackoverflow.com/a/17063741/3451115
How to POST JSON Data via HTTP API using VBScript?
But, I'm still at a loss as to how to replicate the CURL statement in VBA
Try to make basic authorization as shown in the below example:
Sub Test()
sUrl = "https://xxxxxxx.waxlrs.com/TCAPI/statements"
sUsername = "*******************"
sPassword = "******************"
sAuth = TextBase64Encode(sUsername & ":" & sPassword, "us-ascii")
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", sUrl, False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Authorization", "Basic " & sAuth
.setRequestHeader "x-experience-api-version", "1.0.0"
.send (stringJSON)
apiWaxLRS = .responseText
End With
End Sub
Function TextBase64Encode(sText, sCharset)
Dim aBinary
With CreateObject("ADODB.Stream")
.Type = 2 ' adTypeText
.Open
.Charset = sCharset
.WriteText sText
.Position = 0
.Type = 1 ' adTypeBinary
aBinary = .Read
.Close
End With
With CreateObject("Microsoft.XMLDOM").CreateElement("objNode")
.DataType = "bin.base64"
.NodeTypedValue = aBinary
TextBase64Encode = Replace(Replace(.Text, vbCr, ""), vbLf, "")
End With
End Function
Related
I'm trying to retrieve a JSON response object through the below query API. When I try to read the responseText in VBA I receive an empty result. However, the exact same request returns correct data from PostMan. Also, the correct data returns from sending the different request bodies. Whenever I try to execute Set Json = JsonConverter.ParseJson(strResponse) and I'm getting the error message Error Parsing JSON: ^ Expecting '{' or '['. Can you please help?
This is VBA code
Dim strUrl As String
Dim reqBody As String
'For search GOSS service API-Step1
strUrl = "https://gossrepo.ins.dell.com/gossv3/api/reporting/service/getrefid"
'create a method for calling HTTP services
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "POST", strUrl, blnAsync, False
reqBody = "{""methodType"":extract,""sourceApplication"":DSA,""searchParameter"":[{""conditionType"":term,""key"":global_bu_id,""value"":11},{""conditionType"":wildcard,""key"":customer_num,""value"":[530007546697]},{""conditionType"":range,""key"":order_date,""value"":[{""from"":2021-08-31,""to"":2021-09-09}]},{""conditionType"":sort,""key"":order_date_time,""value"":desc}],""pageSize"":40,""pageNum"":0}"
.SetRequestHeader "Content-type", "application/json"
.Send reqBody
While hReq.ReadyState <> 4
DoEvents
Wend
'wrap the response in a JSON root tag "data" to count returned objects
strResponse = hReq.ResponseText
Debug.Print strResponse
End With
Set Json = JsonConverter.ParseJson(strResponse)
Updated the fixed with the different post body:
Dim strUrl As String
Dim reqBody As String
'For search GOSS service API-Step1
strUrl = "https://gossrepo.us.dell.com/gossv3/api/reporting/service/getdata"
'create a method for calling HTTP services
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "POST", strUrl, blnAsync, False
reqBody = "{""methodType"":""details"",""sourceApplication"":""DSA"",""pageNum"":0,""pageSize"":300,""searchParameter"":[{""conditionType"":""term"",""key"":""global_bu_id"",""value"":""11""},{""conditionType"":""wildcard"",""key"":""customer_num"",""value"":[""" & ws & """]},{""conditionType"":""range"",""key"":""order_date"",""value"":[{""from"":""" & ws11 & """,""to"":""" & ws12 & """}]},{""conditionType"":""sort"",""key"":""order_date_time"",""value"":""desc""}]}"
.SetRequestHeader "Content-type", "application/json"
.Send reqBody
While hReq.ReadyState <> 4
DoEvents
Wend
'wrap the response in a JSON root tag "data" to count returned objects
strResponse = hReq.ResponseText
End With
Set Json = JsonConverter.ParseJson(strResponse)
Probably your request is wrong and you don't get the expected response because of it... Look at the status that's returned (hReq.status and hReq.statusText), I bet it's 400 Bad Request or 500 Internal Error and not 200 Ok. (You could also use an inspecting proxy like Fiddler to look at what exactly you send and receive here.)
I can already see your request body is invalid JSON as it has unquoted strings in it... It's not the exact same as you showed in Postman! That's like the issue (or one of the issues). You have e.g. "methodType": extract, but it has to be "methodType": "extract" (in VBA ""methodType"": ""extract"") - you did it correctly in Postman but wrong in your code.
As mentioned by CherryDT - Your original reqBody had alot of missing quotes and in your updated reqBody, you are missing quotes for order_date and also you quoted pageSize and pageNum value which is supposed to be a number and thus quotes is not required:
Below should give you the same JSON string as what you had in Postman:
reqBody = "{""methodType"":""extract"",""sourceApplication"":""DSA"",""searchParameter"":[{""conditionType"":""term"",""key"":""global_bu_id"",""value"":""11""},{""conditionType"":""wildcard"",""key"":""customer_num"",""value"":[""530007546697""]},{""conditionType"":""range"",""key"":""order_date"",""value"":[{""from"":""2021-08-31"",""to"":""2021-09-09""}]},{""conditionType"":""sort"",""key"":""order_date_time"",""value"":""desc""}],""pageSize"":40,""pageNum"":0}"
One way which has been working well for me so far is:
Copy the JSON string from Postman to Notepad
Open Replace dialog (Ctrl-H)
Enter " in Find What
Enter "" in Replace with
Click Replace All
Now you can copied the new string back to your VBA editor and it should produce the same output as Postman's.
Using VBA, I am able to authenticate the user and obtain 'code' successfully using my sandbox account. However, when I attempt to exchange the permission token for an access token, I get status code 400, Bad Request (unsupported_grant_type). I searched for similar problems and tried many suggestions to no avail. I have been successful in using the implicit grant process, but would like to now switch to code grant. I validated the Base64 conversion using an online tool. It worked fine. The process looks very simple and straight forward. Any help is much appreciated.
The VBA code I'm using follows:
strURL = "https://account-d.docusign.com/oauth/token"
strAuthorization = Base64EncodeString(gstrIntegrationKey & ":" & gstrSecretKey)
Set objJSON = New Dictionary
objJSON.Add "grant_type", "authorization_code"
objJSON.Add "code", strCode
strJSON = JsonConverter.ConvertToJson(objJSON)
Set objHTTP = New MSXML2.XMLHTTP60
objHTTP.Open "POST", strURL, False
objHTTP.setRequestHeader "Content-Type: ", "application/x-www-form-urlencoded"
objHTTP.setRequestHeader "Accept: ", "application/json"
objHTTP.setRequestHeader "Authorization: ", "Basic " & strAuthorization
objHTTP.send strJSON
Do Until objHTTP.ReadyState = 4
DoEvents
Loop
strResponse = Replace(objHTTP.responseText, "null", """null""")
If objHTTP.Status <> 200 Then
If Not DocuSignErr(strResponse, objHTTP.Status, objHTTP.statusText) Then Stop
GoTo FailedExit
End If
The body should be form URL encoded not JSON encoded. Instead of using the Dictionary and running it through JsonConverter.ConvertToJson, you should encode it in as a form (e.g., value1=a&value2=b). So, you can do something like this:
strURL = "https://account-d.docusign.com/oauth/token"
strAuthorization = Base64EncodeString(gstrIntegrationKey & ":" & gstrSecretKey)
Set objHTTP = New MSXML2.XMLHTTP60
objHTTP.Open "POST", strURL, False
objHTTP.setRequestHeader "Content-Type: ", "application/x-www-form-urlencoded"
objHTTP.setRequestHeader "Accept: ", "application/json"
objHTTP.setRequestHeader "Authorization: ", "Basic " & strAuthorization
objHTTP.send "grant_type=authorization_code&code=" & strCode
...
I have been trying to wrap my head around this VBA-Web doc http://vba-tools.github.io/VBA-Web/docs/ in order to pass auth_key and other parameters in a post request. I understand the concept of encoding the auth_key as explained here How to pass API key in VBA for Get and Post Request?. But I need help to include all the parameters below in VBA.
UPDATE:
I was able to make QHarr's code below work. But I'm still finding it hard to use my own curl parameters below. I've tried using EncodeBase64(apikey) but I'm not there yet.
Public Sub GetResults()
Dim data As String, json As Object '< VBE > Tools > References > Microsoft Scripting Runtime
data = "{""domainNames"":[""google.com""]}"
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", "https://api.dev.name.com/v4/domains:checkAvailability", False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.setRequestHeader "Authorization", "Basic " + _
EncodeBase64("username" + ":" + "Token")
.send data
Set json = JsonConverter.ParseJson(.responseText)
Dim result As Object
For Each result In json("results")
Debug.Print result("domainName")
Next
End With
End Sub
Function EncodeBase64(text As String) As String
Dim arrData() As Byte
arrData = StrConv(text, vbFromUnicode)
Dim objXML As MSXML2.DOMDocument60
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument60
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = Application.Clean(objNode.text)
Set objNode = Nothing
Set objXML = Nothing
End Function
Here is the API doc - https://cloud.ibm.com/apidocs/
Feature request:
curl -X POST \
-H "Content-Type: application/json" \
-u "apikey:{apikey}" \
-d #parameters.json \
"{url}/v1/analyze?version=2019-07-12"
Example parameter:
{
"features": {
"semantic_roles": {}
},
"text": "IBM has one of the largest workforces in the world"
}
I'm trying to build a script that will generate a post in JSON format, and send it to a listener I have setup for testing. For my purpose I want to have my specific message("Hello world" sent along with a UUID I generate. I wont both of these objects to be easily queried, but the problem I get is when I sniff the traffic, it looks like this:
"form": {
"{\"UUID\": \"{D3F8FC28-C5FE-4B73-ADA4-FD459267B067}\" , \"Post\": hello world}": ""
},
I'm trying to figure out the best way to get rid of the slashes..... I know they are put in to exclude the double quotes, but I need those to be proper json format.... I'm sure there is an easier way to do what I'm trying, but I'm not familar with VBs at all. If anyone could advise on how to get rid of the '\'s easily, or if there is a better way to send json, I would appreciate it.
Heres my Code:
'URL of listener
sUrl = "http://httpbin.org/post"
'Generate uuid
Set TypeLib = CreateObject("Scriptlet.TypeLib")
uuid = TypeLib.Guid
uuid = Left(uuid, Len(uuid)-2)
post = "Hello world"
sRequest = "{""UUID"": """ & UUID & """ , ""Post"": "& post &"}"
'function needed to send post
HTTPPost sUrl, sRequest
Function HTTPPost(sUrl, sRequest)
set oHTTP = CreateObject("Microsoft.XMLHTTP")
oHTTP.open "POST", sUrl,false
oHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oHTTP.setRequestHeader "Content-Length", Len(sRequest)
oHTTP.send sRequest
HTTPPost = oHTTP.responseText
End Function
Set wshShell = CreateObject( "WScript.Shell" )
Credit to #Lankymart for identifying the wrong application type above, here is the solution. It had to be switched to appication/JSON and it was missing some quotes.
'URL of listener
sUrl = "http://httpbin.org/post"
'Generate uuid
Set TypeLib = CreateObject("Scriptlet.TypeLib")
uuid = TypeLib.Guid
uuid = Left(uuid, Len(uuid)-2)
post = "Hello world"
sRequest = "{""UUID"": """ & UUID & """ , ""Post"": """& post &"""}"
'function needed to send post
HTTPPost sUrl, sRequest
Function HTTPPost(sUrl, sRequest)
set oHTTP = CreateObject("Microsoft.XMLHTTP")
oHTTP.open "POST", sUrl,false
oHTTP.setRequestHeader "Content-Type", "application/json"
oHTTP.setRequestHeader "Content-Length", Len(sRequest)
oHTTP.send sRequest
HTTPPost = oHTTP.responseText
End Function
Set wshShell = CreateObject( "WScript.Shell" )
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)