Translate "-d" in VBA when doing an HTTP Request - vba

I try to get a list of actions from iAuditor filtered by "template_id" by sending an HTTP Request with VBA. For the moment I have this code that return the list of all actions:
Sub Get_Data()
Dim hReq As Object
Dim sht As Worksheet
Dim authKey As String
Dim response As String
authKey = "d8a0df7d7e1XXXXXXXXXXXXXXXXXXXXXXXXff3c765cf2fcf"
Set sht = Sheets(1)
Dim strUrl As String
strUrl = "https://api.safetyculture.io/tasks/v1/actions/list"
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "POST", strUrl, False
.SetRequestHeader "Authorization", "Bearer " & authKey
.SetRequestHeader "Content-Type", "application/json"
.Send
End With
response = hReq.ResponseText
'MsgBox Len(response)
sht.Range("A1") = response
End Sub
Now I want to "translate" a filter to VBA but I have no idea how to do it.
Here is my API Documentation about the website : https://developer.safetyculture.io/#actions
So what i want to translate in VBA looks like this in HTTP code i guess :
curl -X POST "https://api.safetyculture.io/tasks/v1/actions/list" \
-H "Authorization: Bearer {api_token}" \
-d {
"template_id": {
"operator": 7,
"value": ["fc2e53f6-4712-4ca5-b681-aba3ac954217"]
}
}
I thank You a lot for any help you can offer me.
Regards,
Gabin

According to this thread:
https://www.vbforums.com/showthread.php?592624-Posting-data-using-XMLHttpRequest
you can add Data to a POST Request by passing it as a value in the send function:
hReq.send "'template_id': {'operator': 7,'value': ['fc2e53f6-4712-4ca5-b681-aba3ac954217']}"
Values are differentiated by a & Symbol inside the string.

I've did it !!! :D
Here is my final code:
Sub Get_Data()
Dim hReq As Object
Dim sht As Worksheet
Dim authKey As String
Dim response As String
Dim response_objet As Object
Dim Body As String
authKey = "d8a0df7d7e19XXXXXXXXXXXXXXXXc65ec9eff3c765cf2fcf"
Body = "{ ""filters"": [ { ""template_id"": { ""value"": [""884b95df35104f4792a3c1fdfed63f0e""]}}]}"
Set sht = Sheets(1)
sht.Range("A3") = Body
Dim strUrl As String
strUrl = "https://api.safetyculture.io/tasks/v1/actions/list"
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "POST", strUrl, False
.SetRequestHeader "Authorization", "Bearer " & authKey
.SetRequestHeader "Content-Type", "application/json"
.Send Body
End With
response = hReq.ResponseText
'MsgBox Len(response)
sht.Range("A1") = response
Set response_objet = JsonConverter.ParseJson(response)
For Each Item In response_objet
a = a + 1
Sheets("Biblio").Range("B" & a) = Item
Next Item
End Sub
Huge thanks to #CodingWolf , he put me on the right direction.
Have a nice day internet.
Gabin,

Related

How to call data stored in a CSV/TEXT file format to range

Good day,
I am struggling to proceed further from this, so with some research, I managed to this point and now i am stuck.
I need assistance to load the data into EXCEL as a datatable.
Here is my code.
Sub MDM_API_CALL()
Dim hReq As Object
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim strUrl As String
strUrl = "url to request bearer token"
Set hReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
With hReq
.Open "POST", strUrl, False
.Send
End With
Dim response As String
response = hReq.responseText
authKey = Mid(response, 11, Len(Mid(response, 11, Len(response) - 12)))
strUrl = "url that requests the data in CSV format"
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", strUrl, False
.SetRequestHeader "Authorization", "Bearer " & authKey
.Send
End With
response = hReq.responseText
ws.Range("A1").Value = response
End Sub
After the code, the data is saved in cell A1 and my data is cropped due to the cell limit.
Thank you

my MSXML2 code not working after 24. loop

the code below doesn't save the data, usually after 24 loops. why might that be? thank you.
Public Sub XmlHttpTutorial()
For x = 1 To 50
Dim xmlhttp As New MSXML2.XMLHTTP60, myurl As String
myurl = "https://www.etsy.com/shop/SilverHandwriting/reviews?page=" & x
xmlhttp.Open "GET", myurl, False
xmlhttp.send
Sheets("sayfa1").Cells(x, "a") = xmlhttp.responseText
Next x
End Sub

Exporting XML file through API

How to upload XML sheet details through API. While I'm using below given VBA code I get an error like certification error.
Sub HTTPPost()
'create an xml object
Dim oXML As Object
Set oXML = CreateObject("MSXML2.DOMDocument")
oXML.async = False
Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oHTTP.setOption(2) = (oHTTP.getOption(2) - SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS)
oHTTP.Open "POST", "https://isp-api-is1-test.prg-dc.com/gateway/CustomerOrder/1.0/CustomerOrder", False
oHTTP.setRequestHeader "Username_IT", "onLwEa54"
oHTTP.setRequestHeader "Content-Type", "application/xml"
oHTTP.setRequestHeader "Accept", "application/xml"
oHTTP.setRequestHeader "APIKey", "163c4821-5a6c-499e-9a9c-ca8b5659e530"
oXML.Load ("C:\Users\nypaul\Downloads\API_CustomerOrder_AFR_V1_52.xml")
oHTTP.send oXML
End Sub
I can't access that address, is it valid?
Otherwise here is the general construct (too long for a comment as is code)
Option Explicit
Const SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS = 13056
Sub HTTPPost()
'create an xml object
Dim oXML As Object, oHTTP As Object
Set oXML = CreateObject("MSXML2.DOMDocument")
oXML.async = False
Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oHTTP.SetOption(2) = (oHTTP.GetOption(2) - SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS)
oHTTP.Open "POST", "https://isp-api-is1-test.prg-dc.com/gateway/CustomerOrder/1.0/CustomerOrder", False
oHTTP.setRequestHeader "Username_IT", "onLwEa54"
oHTTP.setRequestHeader "Content-Type", "application/xml"
oHTTP.setRequestHeader "Accept", "application/xml"
oHTTP.setRequestHeader "APIKey", "163c4821-5a6c-499e-9a9c-ca8b5659e530"
oXML.Load ("C:\Users\nypaul\Downloads\API_CustomerOrder_AFR_V1_52.xml")
oHTTP.send oXML
End Sub

Calling specific variable VBA Rest API [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
I am struggling to understand how I can call a specific variable and organize it in an excel worksheet.
I need to get the buy, sell and vol from this url https://api.blinktrade.com/api/v1/BRL/ticker?crypto_currency=BTC but I am not able to find out how to separate it.
I am using this code to call the data
Public Sub btcteste()
'Dim xmlhttp As Object
Dim xmlhttp As New MSXML2.ServerXMLHTTP60
Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
Dim myurl As String
myurl = "https://api.blinktrade.com/api/v1/BRL/ticker?crypto_currency=BTC"
xmlhttp.Open "GET", myurl, False
xmlhttp.send
MsgBox (xmlhttp.responseText)
End Sub
And it is working but how can I separate the variables and paste it in single cells?
Thanks
Public Sub btcteste()
Dim xmlhttp As Object
'Dim xmlhttp As New MSXML2.ServerXMLHTTP60
Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
Dim myurl As String
myurl = "https://api.blinktrade.com/api/v1/BRL/ticker?crypto_currency=BTC"
xmlhttp.Open "GET", myurl, False
xmlhttp.send
Dim data As Variant
data = xmlhttp.responseText
Debug.Print data
' example data
' {"high": 13400.0, "vol": 616.03500983, "buy": 12830.59, "last": 12899.78, "low": 11800.0, "pair": "BTCBRL", "sell": 12899.78, "vol_brl": 7808332.67293126}
' split at comma (,) , and then split at colon (:)
data = Split(data, ",") ' convert to array
ActiveWorkbook.Sheets("Sheet1").Range("b2:b4") = Application.Transpose(Array("buy", "sell", "vol"))
' buy, sell and vol
ActiveWorkbook.Sheets("Sheet1").Range("c2") = Split(data(2), ":")(1) ' buy
ActiveWorkbook.Sheets("Sheet1").Range("c3") = Split(data(6), ":")(1) ' sell
ActiveWorkbook.Sheets("Sheet1").Range("c4") = Split(data(1), ":")(1) ' vol
End Sub
Try this code.
Public Sub btcteste()
Dim xmlhttp As Object
'Dim xmlhttp As New MSXML2.ServerXMLHTTP60
Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
Dim myurl As String
Dim strText As String
Dim vSplit As Variant, v As Variant
Dim vR() As Variant
Dim n As Integer
myurl = "https://api.blinktrade.com/api/v1/BRL/ticker?crypto_currency=BTC"
xmlhttp.Open "GET", myurl, False
xmlhttp.send
'MsgBox (xmlhttp.responseText)
strText = xmlhttp.responseText
strText = Replace(strText, "}", "")
strText = Replace(strText, "{", "")
strText = Replace(strText, Chr(34), "")
vSplit = Split(strText, ",")
For Each v In vSplit
n = n + 1
ReDim Preserve vR(1 To 2, 1 To n)
vR(1, n) = Trim(Split(v, ":")(0))
vR(2, n) = Trim(Split(v, ":")(1))
Next v
Range("a1").Resize(n, 2) = WorksheetFunction.Transpose(vR) '<~~ this is vertical
'Range("a1").Resize(2, n) = vR '<~~ this is horisontal
End Sub

URL check in VBA error

I have code like below. And I receive error
"run-time error '-2146697211 *800c0005)'': the system cannot locate the resource specified"
I do not know how to solve it thanks in advance for any help. Line in which error is handled is httpRequest.send
Function pullSomeSite(urlcheck As String) As Boolean
Dim httpRequest As xmlhttp
Set httpRequest = New xmlhttp
Dim URL As String
URL = urlcheck
With httpRequest
.Open "POST", URL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send !!!!!!here code stops!!!!!!!
End With
With httpRequest
While Not .readyState = 4 '<---------- wait
Application.Wait Now + TimeValue("0:00:01")
Wend
'Debug.Print .Status
If .Status = 200 Then
While InStr(1, .responseText, "Updating", 0) > 0 '<---------- wait again
Application.Wait Now + TimeValue("0:00:01")
Wend
pullSomeSite = True
Else
pullSomeSite = False
End If
End With
End Function
Test this :
Sub Test_URLExists()
Dim url As String
url = "http://stackoverflow.com/questions/33940044/url-check-in-vba-error"
MsgBox url, vbInformation, URLExists(url)
url = "http://stackoverflow.com/questions/12345678/url-check-in-vba-error"
MsgBox url, vbInformation, URLExists(url)
End Sub
here is how to test an URL with a function :
Function URLExists(url As String) As Boolean
Dim Request As Object
Dim ff As Integer
Dim rc As Variant
URLExists = False
On Error GoTo EndNow
Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")
With Request
.Open "GET", url, False
.Send
rc = .StatusText
End With
Set Request = Nothing
If rc = "OK" Then URLExists = True
Exit Function
EndNow:
End Function
Instead of xmlhttp data type use object.
Use the below code.
. You need to give input as "http://google.com"
Sub test1()
a = pullSomeSite("http://www.flipkart.com")
MsgBox a
End Sub
Function pullSomeSite(urlcheck As String) As Boolean
Dim httpRequest As Object
Set httpRequest = CreateObject("MSXML2.XMLHTTP")
'Set httpRequest = New xmlhttp
Dim URL As String
URL = urlcheck
With httpRequest
.Open "POST", URL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send '!!!!!!here code stops!!!!!!!
End With
With httpRequest
While Not .readyState = 4 '<---------- wait
Application.Wait Now + TimeValue("0:00:01")
Wend
'Debug.Print .Status
If .Status = 200 Then
While InStr(1, .responseText, "Updating", 0) > 0 '<---------- wait again
Application.Wait Now + TimeValue("0:00:01")
Wend
pullSomeSite = True
Else
pullSomeSite = False
End If
End With
End Function