I'm trying to access a soap webservice via classic asp over https, but I get the following error.
MSXML3.DLL error '800c000e'
A security problem occurred.
My code:
Function GetASPNetResources()
Dim returnString
Dim myXML
Dim objRequest
Dim objXMLDoc
Dim strXmlToSend
Dim webserviceurl
Dim webserviceSOAPActionNameSpace
strXmlToSend = "<some valid xml>"
webserviceurl = "https://webserviceurl"
webserviceSOAPActionNameSpace = "appname"
Set objRequest = Server.createobject("MSXML2.XMLHTTP.3.0")
objRequest.open "POST", webserviceurl, False
objRequest.setRequestHeader "Content-Type", "application/soap+xml"
objRequest.setRequestHeader "CharSet", "utf-8"
objRequest.setRequestHeader "action", webserviceSOAPActionNameSpace & "GetEstimate"
objRequest.setRequestHeader "SOAPAction", webserviceSOAPActionNameSpace & "GetEstimate"
Set objXMLDoc = Server.createobject("MSXML2.DOMDocument.3.0")
objXMLDoc.loadXml strXmlToSend
objRequest.Send()
Response.Write objXMLDoc.load(objRequest.responseXML)
End Function
Did you google for that error ?
SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS = 13056
objRequest.setOption 2, SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
Related
Here I am always getting "The remote server returned an error: (500) Internal Server Error.". Even the API is correct and working nicely through POSTMAN and in other languages also. Please guide me so solve this issue. I am attaching the function which is calling the API directly.
Private Function SendRequest() As String
Dim response As String
Dim request As WebRequest
Dim encoding As New System.Text.ASCIIEncoding
Dim uri = ""
Dim Tran = "15"
Dim Amount As Integer = 1000
Dim ReferenceID = "015bfa15-15ec-4dc7-903c-053ffacb6688"
Dim POS = "57290070"
Dim Store = "RESTSIM00000001"
Dim Chain = "J#P-Reg"
Dim JSONString = "{""tran"":""" & Tran & """,""amount"":""" & Amount & """,""reference"":""" & ReferenceID & """,""pos"":""" & POS & """,""store"":""" & Store & """,""chain"":""" & Chain & """}"
Dim jsonDataBytes() As Byte = encoding.GetBytes(JsonConvert.SerializeObject(JSONString))
request = WebRequest.Create(uri)
request.ContentLength = jsonDataBytes.Length
request.ContentType = "application/json"
request.Method = "POST"
Using requestStream = request.GetRequestStream
requestStream.Write(jsonDataBytes, 0, jsonDataBytes.Length)
requestStream.Close()
Using responseStream = request.GetResponse.GetResponseStream
Using reader As New StreamReader(responseStream)
response = reader.ReadToEnd()
End Using
End Using
End Using
Return response
End Function
I'm having trouble creating new Wrike tasks using VB.net and the Wrike API. I however, am able to connect to Wrike to GET a list of folders so I know I'm able to successfully authenticate.
Link to task creation docs:
https://developers.wrike.com/documentation/api/methods/create-task
The only required field is "Title"
Dim accessToken As String = API_Token
Dim apiVersion As String = "v4"
Dim ApiBaseUrl As String = "https://www.wrike.com"
Dim folderID As String = "Some Folder ID Here"
Dim address As String = ApiBaseUrl & "/api/" & apiVersion & "/folders/" & folderID & "/tasks"
Dim result As String
Dim task_str_ As String = "importance=Normal&description=Test task description&dates={""start"":""2019-07-24"",""due"":""2019-07-30""}&title=Task Created With VS&status=Active"
Try
Dim request As HttpWebRequest = TryCast(WebRequest.Create(address), HttpWebRequest)
request.Headers.Add("Authorization", "Bearer " & accessToken)
request.Method = "PUT"
request.ContentType = "application/json"
Using requestWriter2 As New StreamWriter(request.GetRequestStream())
requestWriter2.Write(task_str_)
End Using
Dim webResp As WebResponse = request.GetResponse()
Using reader = New StreamReader(webResp.GetResponseStream)
result = reader.ReadToEnd()
End Using
TextBox1.Text = (result)
Catch ex As Exception
TextBox1.Text = ex.ToString
End Try
Here is the error I'm receiving:
System.Net.WebException: The remote server returned an error: (400) Bad Request
Once I made the suggested changes, everything works good.
Dim accessToken As String = API_Token
Dim apiVersion As String = "v4"
Dim ApiBaseUrl As String = "https://www.wrike.com"
Dim folderID As String = "Some Folder ID Here"
Dim address As String = ApiBaseUrl & "/api/" & apiVersion & "/folders/" & folderID & "/tasks"
Dim result As String
Dim task_str_ As String = "importance=Normal&description=Test task description&dates={""start"":""2019-07-24"",""due"":""2019-07-30""}&title=Task Created With VS&status=Active"
Try
Dim request As HttpWebRequest = TryCast(WebRequest.Create(address), HttpWebRequest)
request.Headers.Add("Authorization", "Bearer " & accessToken)
request.Method = "POST"
request.ContentLength = task_str_.Length
request.ContentType = "application/x-www-form-urlencoded"
Using requestWriter2 As New StreamWriter(request.GetRequestStream())
requestWriter2.Write(task_str_)
End Using
Dim webResp As WebResponse = request.GetResponse()
Using reader = New StreamReader(webResp.GetResponseStream)
result = reader.ReadToEnd()
End Using
TextBox1.Text = (result)
Catch ex As Exception
TextBox1.Text = ex.ToString
End Try
I need to make status message on excel after calling the api . status message in xml format so how to parse the data accurately.
Below given codes are using to get API info
Sub Test()
Dim xmlHTTP As Object
Set xmlHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
myURL = "http://xxxxxxxxxxxxx:15555/gateway/StatusTracking/1.0/shipment/tracking?housebill=cvvvv"
xmlHTTP.Open "GET", myURL, False
xmlHTTP.SetRequestHeader "APIKey", "xxxx-xxx-xxxxx-xxxx-xxxx"
xmlHTTP.SetRequestHeader "Accept", "application/json"
xmlHTTP.Send
Dim strReap As String
strReap = hReq.ResponseText
Dim xmlDoc As New MSXML2.DOMDocument
If Not xmlDoc.LoadXML(strReap) Then
MsgBox "Load error"
End If
Dim xnodelist As MSXML2.IXMLDOMNodeList
Set xnodelist = xmlDoc.getElementsByTagName("ShipmentTracking")
Dim xnode As MSXML2.IXMLDOMNode Set xnode = xnodelist.Item(0)
Dim obAtt1 As MSXML2.IXMLDOMAttribute
Dim obAtt2 As MSXML2.IXMLDOMAttribute
Dim xChild As MSXML2.IXMLDOMNode
Dim intRow As Integer
intRow = 2
Dim strCol1 As String
strCol1 = "A"
Dim strCol2 As String
strCol1 = "B"
Dim Shipment As String
For Each xChild In xnode.ChildNodes
Set obAtt1 = xChild.Attributes.getNamedItem("Shipment")
ws.Cells(intRow, 2) = obAtt1
intRow = intRow + 1
Next xChild
Set hReq = Nothing
Set xmlDoc = Nothing
End Sub
normal xml status message format given below
<Shipment tracking>
<type/>
<object/>
<properties/>
<Shipment>
<Origin/>
<type/>
<properties/>
<LocationCode/>
<CountryCode/>
</Shipment>
</Shipment tracking>
I am newbie in vba programming and i tried with this code but not working fine. I just want output,from shipment(xmltagname) to end in excel sheet. Please help me on this
You have written code Attributes.getNamedItem when in fact you have no attributes. Also to query for elements I'd prefer selectNodes and selectSingleNode instead of getElementsByTagName.
So try
xChild.selectSingleNode("Shipment")
and change the declaration for the receiving variable from IXMLDOMAttribute to IXMLDOMElement
I am using https://developer.companieshouse.gov.uk/api/docs/ to access an API
I have my API key, however, i am not sure how to pass that from VBA. So far i tried below
AuthKey = [Key received]
With CreateObject("Microsoft.XMLHTTP")
.Open "GET", strUrl, False, authKey
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Accept", "application/json"
.SetRequestHeader "Authorization", "Basic " & AuthKey
.Send
response = .ResponseText
End With
When i try from their test page https://developer.companieshouse.gov.uk/document/docs/document/id/content/fetchDocument.html it works well and when i goto dev tools that Authorization key is different, i think i am missing some encoding. Can someone please help
Thanks
Basic auth requires the username and password to be base 64 encoded together. The AuthKey you need to pass is essentially:
def unencoded_auth = "[username]:[authkey]"
def encoded_auth = *call-to-base64-encode-value*(unencoded_auth)
Then you would replace
"Basic " & AuthKey
with
"Basic " & encoded_auth
I'll reference this post as to how to achieve the base64 encoding.
I found it.. i was missing to encode the key
Function EncodeBase64(text As String) As String
Dim arrData() As Byte
arrData = StrConv(text, vbFromUnicode)
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
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
I have an Excel macro that has been in use for years which posts to a database using an XMLHttp call. The code is digitally signed.
Recently the site which is being posted to has enabled ADFS. Now instead of getting xml back I get the contents of the ADFS authentication form. There is no prompt for credentials in it since authentication already occurred. It I open the url from a web browser it goes through as expected with existing credentials used and the page loaded.
I tried setting the trusted setting for the url and allowed external content but that didn't matter.
Have I missed something?
The html I get back looks like...
<html><head><title>Working...</title></head><body><form method="POST" name="hiddenform" action="https://isvcci.jttest.com:444/"><input type="hidden" name="wa" value="wsignin1.0" />
...
<noscript><p>Script is disabled. Click Submit to continue.</p><input type="submit" value="Submit" /></noscript></form><script language="javascript">window.setTimeout('document.forms[0].submit()', 0);</script></body></html>
This is the vba:
Sub PostXml(strType As String, strAddress As String, objXml As MSXML2.DOMDocument60)
Dim objHttp As MSXML2.XMLHTTP60, objXmlResponse As MSXML2.DOMDocument60, objNode As MSXML2.IXMLDOMNode
Dim strText As String
Set objHttp = New MSXML2.XMLHTTP60
objHttp.Open "POST", strAddress, False
objHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
objHttp.send objXml
Set objXmlResponse = objHttp.responseXML
rem responseXML is always empty but responseText has the adfs page <------
Set objNode = objXmlResponse.SelectSingleNode("root/errorMessage")
If objNode Is Nothing Then
MsgBox "Error: Unable to retrieve expected response from the server." + vbCrLf + "The opportunity may not have been updated."
Else
... code for success goes here
End If
End Sub
Thanks for any assistance!
XMLHttp wouldn't work over adfs so I used an InternetExplorer control instead. It's a hassle to get the resulting xml back though using a page which sets a form value would probably be simpler. The resulting xml gets returned formatted like what you see in a web browser. I use a simple regex to remove dashes outside of tags.
I'm not that experienced with vba and excel so there might be better ways to code this but it works.
Sub PostXml(strType As String, strAddress As String, objXml As MSXML2.DOMDocument60)
Dim objHttp As MSXML2.XMLHTTP60, objXmlResponse As MSXML2.DOMDocument60, objNode As MSXML2.IXMLDOMNode
Dim objDoc As MSHTML.HTMLDocument
Dim strText As String, strHeaders As String, strPostData As String
Dim MyBrowser As InternetExplorer
Dim PostData() As Byte
Dim expr As VBScript_RegExp_55.RegExp
Dim colMatch As VBScript_RegExp_55.MatchCollection
Dim vbsMatch As VBScript_RegExp_55.Match
Dim sMatchString As String
' XMLHttp doesn't work with ADFS so browser was used
Set MyBrowser = New InternetExplorer
strHeaders = "Content-Type: text/xml; charset=utf-8" & vbCrLf
PostData = StrConv(objXml.XML, vbFromUnicode)
MyBrowser.Visible = False
MyBrowser.navigate strAddress, 0, "", PostData, strHeaders
Do While MyBrowser.Busy Or MyBrowser.readyState <> 4
Loop
Set objDoc = MyBrowser.Document
strText = objDoc.body.innerText
Set expr = New VBScript_RegExp_55.RegExp
expr.Pattern = "(?:\s| |^)(-)(?=\s|\r|\n|$)"
expr.IgnoreCase = True
expr.MultiLine = True
expr.Global = True
strText = expr.Replace(strText, "")
Set objXmlResponse = New MSXML2.DOMDocument60
Set objNode = Nothing
If objXmlResponse.LoadXML(strText) Then
Set objNode = objXmlResponse.SelectSingleNode("root/errorMessage")
'Else
'MsgBox "Invalid XML " & objXmlResponse.parseError.ErrorCode & "," & objXmlResponse.parseError.reason
End If
MyBrowser.Quit
Set MyBrowser = Nothing
Rem MsgBox "response =" & vbCrLf & objXmlResponse.XML
If objNode Is Nothing Then
MsgBox "Error: Unable to retrieve expected response from the server."
Else
strText = objNode.Text
If strText > "" Then
MsgBox strText, vbOKOnly, "Error"
Else
' it worked, read the xml here
End If
End If
End Sub