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
Related
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,
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
I need to create a macro that imports some data from a CSV file. However, I can only access the file by running a static, non-dynamic URL after I have navigated to a URL that has an identifier that changes for every client.
i.e. I need to navigate to https://fsfsf.asdfsf.com/sdfgfg/fssfs.aspx?previewaction=XXXX and then instantiate https://fsfsf.asdfsf.com/sdfgfg/sdfsdf/FieldAttributes, which in a browser would cause the file to be downloaded.
Thanks!
Would I be doing this, then?
So, I'd be doing
Sub DownloadFile()
Dim myURL As String
myURL = "https://secure.infosnap.com/family/gosnap.aspx?previewaction=13461"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send
myURL = "https://secure.infosnap.com/family/ActionForms/FieldAttributes"
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send
myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile "C:\file.csv", 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub
Instead of having this information show up as a message box, how can I modify the code so that that data is inputted into Sheet1.Range("A1")? Any help is greatly appreciated.
Sub Demo()
With CreateObject("Msxml2.XMLHTTP")
.Open "GET", "http://www.realtytrac.com/property" & Sheet1.Range("J11"), False
.setRequestHeader "DNT", "1"
.Send
MsgBox Split(Split(.responseText, "itemprop='propertyID'>")(1), "<")(0)
End With
End Sub
Sub Demo()
With CreateObject("Msxml2.XMLHTTP")
.Open "GET", "http://www.realtytrac.com/property" & Sheet1.Range("J11"), False
.setRequestHeader "DNT", "1"
.Send
val = Split(Split(.responseText, "itemprop='propertyID'>")(1), "<")(0)
ThisWorkbook.Sheets(1).Range("A1").value = val
End With
End Sub
If you have a valid response in your XMLHTTP object you should be able to use the following:
Sub Demo()
With CreateObject("Msxml2.XMLHTTP")
.Open "GET", "http://www.realtytrac.com/property" & Sheet1.Range("J11"), False
.setRequestHeader "DNT", "1"
.Send
ThisWorkbook.Sheets(1).Range("A1").Value = Split(Split(.responseText, "itemprop='propertyID'>")(1), "<")(0)
End With
End Sub
I am trying to download a file from IBM Cognos via Excel VBA. The script will execute, but I only get a 9KB Excel file that will not open. How do I make this work?
Here is my code:
Sub ado_stream()
'add a reference to Microsoft XML v6 and MS ActiveX Data Objects
'via Tools/References
'This assumes the workbook is saved already, and that you want the file in the same folder
Dim fileStream As ADODB.Stream
Dim xmlHTTP As MSXML2.xmlHTTP
Dim strURL As String
strURL = "http://foo.bar"
Set xmlHTTP = New MSXML2.xmlHTTP
xmlHTTP.Open "GET", strURL, False, "username", "password"
xmlHTTP.Send
If xmlHTTP.status <> 200 Then
MsgBox "File not found"
GoTo exitsub
End If
Set fileStream = New ADODB.Stream
With fileStream
.Open
.Type = adTypeBinary
.Write xmlHTTP.responseBody
.Position = 0
.SaveToFile "C:\Users\myname\Downloads\Test.xlsx"
.Close
End With
exitsub:
Set fileStream = Nothing
Set xmlHTTP = Nothing
End Sub
try sending the password via auth header. see if that works.
Set xmlHTTP = New MSXML2.xmlHTTP
xmlHTTP.Open "GET", strURL, False
xmlHTTP.setRequestHeader "Authorization", "Basic " & EncodeBase64
xmlHTTP.Send
'EncodeBase Function. Put your actual user name and password here.
Private Function EncodeBase64() As String
Dim arrData() As Byte
arrData = StrConv("<<username>>" & ":" & "<<password>>", vbFromUnicode)
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.text
Set objNode = Nothing
Set objXML = Nothing
End Function