HTTP request (Stripe) VBA send DATA - getting error after days of working - vba

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.

Related

VBA TalentLMS API Post Request with multipart/form-data throwing error when passing Request Body with boundaries in as a string parameter

I am creating a Module in MS Access to make API calls to different endpoints in the TalentLMS API. I am creating functions to minimize the code needed for each endpoint. So far all of my GET requests are working. I have a POST request to add a user account working as well. The problem that I am running into is that I have a POST request to delete a user account that works if I generate the multipart/form-data (Request Body) in the API Call function but does not work if I pass the mutlipart/form-data (Request Body) in as a parameter to the API Call function.
This is Working I generate the request body with boundaries within the API call function as a string.
Function talentAPICall_3(ByVal intUserid As Integer, ByVal strPermanent As String) As String
Dim request As New MSXML2.XMLHTTP30
Dim apiURL, boundary, postData, strRequest, strResponse As String
Dim contentLen As Long
apiURL = "https://<<myDomain>>.talentlms.com/api/v1/"
strRequest = apiURL & "deleteuser/"
boundary = "----------------------------" & Format(Now, "ddmmyyyyhhmmss")
postData = "--" & boundary & vbCrLf & _
"Content-Disposition: form-data; name=""user_id""" & vbCrLf & _
"Content-Type: text/plain; charset=UTF-8" & vbCrLf & vbCrLf & _
intUserid & vbCrLf & _
"--" & boundary & vbCrLf & _
"Content-Disposition: form-data; name=""permanent""" & vbCrLf & _
"Content-Type: text/plain; charset=UTF-8" & vbCrLf & vbCrLf & _
strPermanent & vbCrLf & _
"--" & boundary & "--"
contentLen = Len(postData)
With request
.Open "POST", (strRequest), False
.setRequestHeader "Authorization", "Basic <<MyAPIKey>>=="
.setRequestHeader "Host", "<<myDomain>>.talentlms.com"
.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
.setRequestHeader "content-Length", contentLen
.send (postData)
While request.ReadyState <> 4
DoEvents
Wend
strResponse = .responseText
End With
Debug.Print "Server responded with status " & request.statusText & " - code: "; request.status
Debug.Print postData
talentAPICall_3 = strResponse
End Function
This is NOT Working Where I use a getBoundaries() function to pass the body request with boundaries as a string to the API call function.
Function DelUser(ByVal intUserid As Integer, ByVal strPermanent As String) As String
Dim postData, strResponse As String
Dim boundaries() As Variant
boundaries = Array("user_id", intUserid, "permanent", strPermanent)
postData = getBoundaries(boundaries)
strResponse = talentAPICall_4(postData)
DelUser = strResponse
End Function
Which calls the following.
Function getBoundaries(params() As Variant) As String
Dim boundary, boundaries As String
boundary = "----------------------------" & Format(Now, "ddmmyyyyhhmmss")
Dim i As Long
boundaries = ""
For i = LBound(params) To UBound(params)
boundaries = boundaries & "--" & boundary & vbCrLf & _
"Content-Disposition: form-data; name=""" & params(i) & """" & vbCrLf & _
"Content-Type: text/plain; charset=UTF-8" & vbCrLf & vbCrLf
i = i + 1
boundaries = boundaries & params(i) & vbCrLf
Next i
boundaries = boundaries & "--" & boundary & "--"
getBoundaries = boundaries
End Function
When the Request Body is generated with boundaries and returned as a string, it is then passed as a parameter to the next function.
Function talentAPICall_4(ByVal postData As String) As String
Dim request As New MSXML2.XMLHTTP30
Dim apiURL, boundary, strRequest, strResponse As String
Dim contentLen As Long
apiURL = "https://<<myDomain>>.talentlms.com/api/v1/"
strRequest = apiURL & "deleteuser/"
boundary = Left(postData, 44)
contentLen = Len(postData)
With request
.Open "POST", (strRequest), False
.setRequestHeader "Authorization", "Basic <<MyAPIKey>>=="
.setRequestHeader "Host", "<<myDomain>>.talentlms.com"
.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
.setRequestHeader "content-Length", contentLen
.send (postData)
While request.ReadyState <> 4
DoEvents
Wend
strResponse = .responseText
End With
Debug.Print "Server responded with status " & request.statusText & " - code: "; request.status
Debug.Print postData
talentAPICall_4 = strResponse
End Function
Here are the results of both methods used:
Working:
call talentAPICall_3(3314, "yes")
Server responded with status OK - code: 200
Posted Data:
------------------------------15022023131313
Content-Disposition: form-data; name="user_id"
Content-Type: text/plain; charset=UTF-8
3314
------------------------------15022023131313
Content-Disposition: form-data; name="permanent"
Content-Type: text/plain; charset=UTF-8
yes
------------------------------15022023131313--
Not Working:
call delUser(3314, "yes")
Server responded with status Bad Request - code: 400
Posted Data:
------------------------------15022023131246
Content-Disposition: form-data; name="user_id"
Content-Type: text/plain; charset=UTF-8
3314
------------------------------15022023131246
Content-Disposition: form-data; name="permanent"
Content-Type: text/plain; charset=UTF-8
yes
------------------------------15022023131246--
As you can see, except for the variation of the time stamp used to create the boundary, the postData from Debug.Print for both functions is the same. The TalentLMS API states that the following for the 400 error code "A required parameter is missing or an invalid type (e.g. a string) was supplied instead of an integer." In both cases postData is a String and they have the same parameters.
Anyone see what I am missing?
In your "working" code the boundary header length is 42, and in the non-working code it's 44?
You need to remove the leading "--"...
boundary = Mid(postData, 3, 42)
Might be safer to pass the boundary in to getBoundaries rather than try to extract it from the output.

How to use ServerXMLHTTP60 and a client SSL certificate in Excel using VBA?

I cannot get it to work in VBA - Excel. I use the same header and XML-body in Postman - fine! Good response. I need to use a client certificate to identify myself, but I cannot get it done in VBA. The code needs to post some data (the XMLPostMessage) and then it receives some data from the server (a XML message as well).
The response I get from the server is a message in XML that has something to do with "Unidentified user". So, I do have communication, but it is not recognised as 'from a trusted party'. But using this certificate in Postman does give a good response.
== My VBA code: ==
Public Sub server()
Dim O As New ServerXMLHTTP60
Dim xmlDoc As New MSXML2.DOMDocument60
Dim XMLPostMessage As String
XMLPostMessage = "<WEB-UAS-AANVR>" & _
"<ALG-GEG>" & _
"<PROC-IDENT>3637</PROC-IDENT>" & _
"<PROC-FUNC>1</PROC-FUNC>" & _
"<INFO-GEBR>DITISEENTEST</INFO-GEBR>" & _
"</ALG-GEG>" & _
"<WEB-UAS-GEG>" & _
"<UAS-VRR-EXAMEN-GEG>" & _
"<UAS-VRR-EX-INST></UAS-VRR-EX-INST>" & _
"<UAS-VRR-EX-SRT>A2</UAS-VRR-EX-SRT>" & _
"<UAS-VRR-EX-DAT>20211210</UAS-VRR-EX-DAT>" & _
"<GEB-DAT-UAS-VRR>19840726</GEB-DAT-UAS-VRR>" & _
"<UAS-VRR-EX-REF>#12345</UAS-VRR-EX-REF>" & _
"</UAS-VRR-EXAMEN-GEG>" & _
"</WEB-UAS-GEG>" & _
"</WEB-UAS-AANVR>"
With O
.Open "POST", "https://<the serverpath goes here>", False
.setRequestHeader "Content-type", "application/xml"
.setRequestHeader "Content-type", "text/xml"
.setRequestHeader "Charset", "UTF-8"
.setOption 3, "<The Friendly Name of the certificate goes here>"
' .setOption 3, "CURRENT_USER\My\<The Friendly Name of the certificate goes here>"
.send XMLPostMessage
xmlDoc.LoadXML (O.responseXML.XML)
Debug.Print xmlDoc.XML
If Not .Status = 200 Then
MsgBox "UnAuthorized. Message: " & .Status & " - " & .statusText
Exit Sub
End If
End With
Set O = Nothing
End Sub

CSV string from GET request incomplete when storing in variable

In VBA, I currently have code that returns a CSV string from the internet. However, it seems like the entire file is not being captured when I try to store it in a string variable using .responseText
I've heard string sizes are limited, which makes this problem understandable (I'm trying to store 1000 rows of data into a variable - which is probably not possible). I was wondering if there is a way to download the CSV file straight from the source given that I have the URL to get the response? Here is the relevant code that I have:
Dim JiraReq As New MSXML2.XMLHTTP60
With JiraReq
' Create Session
downloadUrl = https://myurlishere.atlassian.net
' This is not the actual form of the URL, but it does
' successfully grab the CSV string (but the string variable
' will not store all of it - probably because of the size)
.Open "GET", downloadUrl, False
.setRequestHeader "Authorization", "Basic " + EncodeBase64(username + ":" + password)
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.send
End With
CSVData = JiraReq.responseText
If JiraReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write JiraReq.responseText
Filename = "C:\file" & i & ".csv"
oStream.SaveToFile Filename, 2
oStream.Close
End If
For reference, I have looked at the following links to try to solve this issue:
Arguments out of acceptable range
Downloading file from web with VBA
HTTP response text returning incomplete Data
My code ended up looking like this:
For i = 1 To pageCount Step 1
' MsgBox "Entering For Loop"
Dim startNumber As Integer
startNumber = (i - 1) * 1000
Dim downloadUrl As String
downloadUrl = "https://myurl.atlassian.net/sr/jira.issueviews:searchrequest-csv-current-fields/" & CStr(filterID) & "/SearchRequest-" & CStr(filterID) & ".csv?tempMax=1000&pager/start=" & CStr(startNumber)
With JiraReq
' Create Session
Debug.Print "Getting page " & CStr(i) & " of " & CStr(pageCount)
.Open "GET", downloadUrl, False
.setRequestHeader "Authorization", "Basic " + EncodeBase64(username + ":" + password)
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.send
End With
file_name = "C:\VBA\file" & i & ".csv"
If JiraReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write JiraReq.responseBody
oStream.SaveToFile file_name, 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
I had to change from .responseText to .responseBody.

VBA HTTP Request POST returning empty string

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

VBA - WinHTTP Authentication on redmine failed

i am looking into this issue since days but i am not able to find a solution.
I want to use WinHttp Authentication via VBA to Login to our Redmine to get the current issues.csv file for my Excel spreadsheets.
I already found this useful question on Stackoverflow and adapted the Code(Not understanding why WinHTTP does NOT authenticate certain HTTPS resource) , but its not working with that as well. I always get the LoginPage html Content as ResponseBody.
This is the specific part of the Code:
Set RegX_AuthToken = CreateObject("VBScript.RegExp")
'Below Pattern w/o double-quotes encoded:(?:Input name="authenticity_token" value=")(.*)(?:")
RegX_AuthToken.Pattern = "(?:input type=" & Chr(34) & "hidden" & Chr(34) & " name=" & Chr(34) & "authenticity_token" & Chr(34) & " value=" & Chr(34) & ")(.*)(?:" & Chr(34) & ")"
RegX_AuthToken.IgnoreCase = True
RegX_AuthToken.Global = True
RegX_AuthToken.MultiLine = True
TargetUrl = myURL
Set httpreq = CreateObject("WinHttp.WinHttpRequest.5.1")
httpreq.Open "GET", TargetUrl, False
httpreq.Send
Set token_Match = RegX_AuthToken.Execute(httpreq.ResponseText)
Authtoken = token_Match(0).SubMatches(0)
PostData = "authenticity_token=" & Authtoken & "&back_url=https://tickets.gbo-datacomp.de/" & "&username=" & "XXX" & "&password=" & "XXX" & "&login=Login ยป"
httpreq.Open "POST", TargetUrl, False
httpreq.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
httpreq.Send (PostData)
TargetUrl = myUrl&"issues.csv"
httpreq.Open "GET", TargetUrl, False
httpreq.Send
oResp = httpreq.ResponseBody
Would be great if somebody could Point me to my mistake.
Thanks in advance for your suggestions!