I am working on a procedure, in MS-Access VBA, to POST an XML text string to a web service and process the XML text string that is returned from the service.
The issue I am having is that the responseText property is always empty when it should contain a XML text string. No errors are returned and the .status = "OK".
I have tried the WinHttp.WinHttpRequest, MSXML2.XMLHTTP, and MSXML2.ServerXMLHTTP objects and consistently have the same issue.
Here is a code example:
Public Function Send() As Boolean
Dim oXHR As MSXML2.XMLHTTP60
Dim sURL, sCred As String
Dim sRequest, sResult, sStatus, sHeader As String
Dim bRtn As Boolean
BuildReqXML
sRequest = Me.RequestXML_String
With orsValues
sURL = .Fields("WebServiceURL").Value
sCred = Base64Encode(Trim(.Fields("User").Value) & ":" & Trim(.Fields("Password").Value))
End With
Set oXHR = New MSXML2.XMLHTTP60
With oXHR
.Open "POST", sURL, False
.SetRequestHeader "Authorization", "Basic " & sCred & """"
.SetRequestHeader "User-Agent", "Mozilla/4.0"
.SetRequestHeader "Content-Type", "text/xml"
.Send sRequest
sStatus = .StatusText
sResult = .ResponseText
sHeader = .GetAllResponseHeaders
If sResult <> "" Then
If Contains(sResult, "<") Then ReadXML sResult, "Response"
Debug.Print sResult
Else
Debug.Print sHeader
Debug.Print sRequest
End If
End With
Set oXHR = Nothing
End Function
I have verified that the web service is working correctly by building a similar call in a HTML document, sending the XML string, and receiving the response XML string.
Can someone please help me fix my issue?
I found the problem, with help from Fiddler.
The line setting the authorization header
.SetRequestHeader "Authorization", "Basic " & sCred & """"
Was adding a (") to the header line. The corrected line is
.SetRequestHeader "Authorization", "Basic " & sCred
Thank you for your help
Related
I have been trying to extract all the data from Clockify into Excel using VBA and using below code but there is no output coming with that code
Your help will be much appreciated.
Getting this reponse when run the code {"code":405,"message":"HTTP 405 Method Not Allowed"}
Public Sub GetAllProjects()
Dim httpCaller As MSXML2.XMLHTTP60
Set httpCaller = New MSXML2.XMLHTTP60
httpCaller.Open "GET", "https://reports.api.clockify.me/v1/workspaces/*****/reports/detailed"
httpCaller.setRequestHeader "X-Api-Key", CLOCKIFY_API_KEY
httpCaller.setRequestHeader "Content-Type", "application/json"
httpCaller.send
Debug.Print httpCaller.responseText
End Sub
A POST would look something like this in VBA:
Public Sub GetAllProjects()
Dim httpCaller As MSXML2.XMLHTTP60, body As String, obj As Object, json As Object, result
Dim ti As Object
'not sure how much of the request body is required....
'adjust dates below as needed
body = "{""dateRangeStart"": ""2020-05-10T00:00:00.000"", " & vbLf & _
" ""dateRangeEnd"": ""2020-05-16T23:59:59.000"", " & vbLf & _
" ""detailedFilter"": {""page"": 1,""pageSize"": 50}} "
Debug.Print body
Set httpCaller = New MSXML2.XMLHTTP60
With httpCaller
.Open "POST", "https://reports.api.clockify.me/v1/workspaces/*****/reports/detailed"
.setRequestHeader "X-Api-Key", CLOCKIFY_API_KEY
.setRequestHeader "Content-Type", "application/json"
.send body 'include JSON body
result = .responseText
Debug.Print "---Response---" & vbLf & result
End With
Set json = JsonConverter.ParseJson(result)
For Each obj In json("totals")
Debug.Print "------"
Debug.Print obj("totalTime")
Debug.Print obj("totalBillableTime")
Debug.Print obj("entriesCount")
Debug.Print obj("totalAmount")
Next obj
For Each obj In json("timeentries")
Debug.Print "------"
Debug.Print obj("_id")
Debug.Print obj("description")
'etc etc
'access the "timeinterval" sub-dictionary
Set ti = obj("timeInterval")
Debug.Print , ti("start")
Debug.Print , ti("end")
Debug.Print , ti("duration")
Next obj
End Sub
I have created a project in Ms Access which creates customer accounts on Stripe. Credit card stuff is via elements in a secure manner.
The situation:
It is running on my test (home) environment fine.
It was running at my business for 2 days
Today I used it and am now getting:
The Connection with the server was terminated abnormally
Code:
reqBody = "description=" & desc & _
"&name=" & pName & _
"&phone=" & pPhone & _
"&address[line1=" & pAdd & _
"&address[city=" & pSuburb & _
"&address[country=AU" & _
"&address[postal_code=" & pPCode & _
"&address[state=Western Australia"
Set httpReq = CreateObject("MSXML2.ServerXMLHTTP")
httpReq.Open "POST", "https://api.stripe.com/v1/customers", False
httpReq.setRequestHeader "Authorization", "Bearer " & api_key
httpReq.send reqBody
strResponse = httpReq.responseText
Set parsed = JsonConverter.ParseJson(strResponse)
'Debug.Print strResponse
StripeCustID = parsed("id")
Now I read some other posts and tried using:
httpReq.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
and still no luck,
I ahve also tried:
Dim HTTPRequest As WinHttp.WinHttpRequest
Set HTTPRequest = New WinHttp.WinHttpRequest
With HTTPRequest
.Open "POST", "https://api.stripe.com/v1/customers", True
.setRequestHeader "Authorization", "Bearer " & api_key
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Option(WinHttpRequestOption_SecureProtocols) = SecureProtocol_TLS1_2
'.Option(WinHttpRequestOption_EnableRedirects) = True
.send reqBody
If .waitForResponse(3) Then
strResponse = .responseText
Debug.Print .responseText
Else
MsgBox "Timed out after 3 seconds."
Exit Sub
End If
End With
But with this it is coming up as [SecureProtocol_TLS1_2] not defined (I have the reference to WinHttp)
My test environment is Windows 10, my work on is Windows 7, both are 64x.
But the fact remains, this was working for two days on the work computers and now giving me this error.
How to GET response using VBA?
This code here does not work. In Debug.Pring() or MsgBox is empty.
TargetURL = snURL + selectedMail
Set HTTPReq = CreateObject("WinHttp.WinHttpRequest.5.1")
HTTPReq.Open "GET", TargetURL, False
HTTPReq.SetCredentials snUser, snPass, 0
HTTPReq.setRequestHeader "Accept", "application/json"
Debug.Print HTTPReq.responseText
I want to get JSON data.
Optional libraries (needed, if early binding is used, in general the code will work without them):
Change the companyName variable:
Sub TestMe()
Dim xmlObject As Object
Dim companyName As String: companyName = "Google"
Dim strUrl As String
strUrl = "http://dev.markitondemand.com/MODApis/Api/v2/Lookup/json?input=" & companyName
Set xmlObject = CreateObject("MSXML2.XMLHTTP")
With xmlObject
.Open "GET", strUrl, False
.Send
End With
Dim response As String
response = "{""data"":" & xmlObject.ResponseText & "}"
Debug.Print response
End Sub
Background/objective: Web Scrape: Problem with the Syntax using the .send
I am attempting to send the last name and first name from a list of names in two columns of cells, I am coming across Syntax Errors as it does not recognize the cell and assumes the range is the "name"
code:
The syntax error begins on the "last" and "first" line under the .send, as I am attempting to send a cell value rather than type in the name. What is the correct formatting when referencing a range of cells?
Option Explicit
Sub Test()
Dim sContent As String
Dim i As Long
Dim j As Long
Dim aHeader() As String
Dim aRows() As String
' Retrieve HTML content via XHR
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://npinumberlookup.org/getResults.php", False
.setRequestHeader "content-type", "application/x-www-form-urlencoded"
.send _
"last=Range(G:1)" & _
"&first=Range(F:1)" & _
"&pracstate=TX" & _
"&npi=" & _
"&submit=Search"
When you want to reference the value of a Range, is exactly as #Qharr said before. I tried doing:
' Retrieve HTML content via XHR
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://npinumberlookup.org/getResults.php", False
.setRequestHeader "content-type", "application/x-www-form-urlencoded"
.send _
"last=" & Range("G1").Value & _
"&first=" & Range("F1").Value & _
"&pracstate=TX" & _
"&npi=" & _
"&submit=Search"
End With
And it worked. No errors when running the code.
The code below only scrapes/parses one page of data (50 results) into excel however, I would like it to scrape multiple pages (500 results) - please help. (Base64Encode was taken from a different source - I don't take credit for it)
`Function GetData() As Boolean
Application.ScreenUpdating = False
Dim objHTTP As New MSXML2.XMLHTTP
Dim strURL As String
Dim strUserName As String
Dim strPassword As String
Sheet1.Range("A2:R2000") = ""
Sheet1.Activate
strUserName = "User"
strPassword = "Password"
For i = 1 To UBound(MyArray)
strURL = "https://.ngx.com/ngxcs/indexPrice.xml"
objHTTP.Open "GET", strURL, False
objHTTP.setRequestHeader "Authorization", "Basic " & Base64Encode(strUserName & ":" & strPassword)
objHTTP.setRequestHeader "Host", "secure.example.com"
objHTTP.setRequestHeader "Content-Type", "text"
objHTTP.send "Nothing"
While objHTTP.readyState <> 4
DoEvents
Wend
Dim strResponseReceived As String
strResponseReceived = objHTTP.responseText
Debug.Print objHTTP.responseText
MsgBox strResponseReceived
Dim xDoc As DOMDocument
Set xDoc = New DOMDocument
xDoc.LoadXML objHTTP.responseText`
''''''''''''''''''''''''''''''''''''''''''
Rest of Code that outputs it into excel
Thanks for the Help!