How to use ServerXMLHTTP60 and a client SSL certificate in Excel using VBA? - 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

Related

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

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.

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!

Referencing a Cell .send Syntax Error // Web Scraping

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.

Image not received, sent via mms using VBA, Twilio and Microsoft ACCESS

I need to send a image from my pc in a text message using Twilio and Microsoft Access.
I was able to successfully send a text message via Microsoft Access. However, the image wasn't sent. I found a parameter called "mediaURL". I am trying to have mediaURL refer to a image on my pc ("d:\imagefolder").
Has anyone been able to do this. Here is my code to send the text message.
Dim MessageUrl As String
Dim FromURLEncode As String
Dim ToURLEncode As String
Dim imageURL As String
On Error GoTo Error_Handler
' setup the URL
MessageUrl = BASEURL & "/2010-04-01/Accounts/" & ACCOUNTSID & "/Messages"
imageURL = "d:\imagefolder\mypicture.png"
' setup the request and authorization
Dim http As MSXML2.XMLHTTP60
Set http = New MSXML2.XMLHTTP60
http.Open "POST", MessageUrl, False, ACCOUNTSID, AUTHTOKEN
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
Dim postData As String
postData = "From=" & fromNumber _
& "&To=" & toNumber _
& "&Body=" & body _
& "&MediaURL=" & imageURL
Debug.Print postData
' send the POST data
http.send postData
' optionally write out the response if you need to check if it worked
Debug.Print http.responseText
If http.Status = 201 Then
ElseIf http.Status = 400 Then
MsgBox "Failed with error# " & _
http.Status & _
" " & http.statusText & vbCrLf & vbCrLf & _
http.responseText
ElseIf http.Status = 401 Then
MsgBox "Failed with error# " & http.Status & _
" " & http.statusText & vbCrLf & vbCrLf
Else
MsgBox "Failed with error# " & http.Status & _
" " & http.statusText
End If
Exit_Procedure:
On Error Resume Next
' clean up
Set http = Nothing
Exit Function
Error_Handler:
Select Case Err.Number
Case NOINTERNETAVAILABLE
MsgBox "Connection to the internet cannot be made or " & _
"Twilio website address is wrong"
Case Else
MsgBox "Error: " & Err.Number & "; Description: " & Err.Description
Resume Exit_Procedure
Resume
End Select
I was finally able to send text messages with images by using MediaUrl. My Code was using MediaURL. It has to be exactly "MediaUrl". Once, I figured that out, I have been able to send text messages with images.
Twilio developer evangelist here.
As Thomas G answered in a comment, your problem is that the image is on your computer. The URL needs to be available to Twilio.
You will need to upload the image to a server, either your own or a public service, and then using the for that server.
Check out the documentation on sending MMS with Twilio for more details.

Using FileSystemObject to Export VBScript Code to Text File

I am looking to replace the MsgBox oXMLHttp.responseText part of the below code with code that exports the results to a text file. I have checked out this post and found the following code:
Set objFSO=CreateObject("Scripting.FileSystemObject")
' How to write file
outFile="c:\test\autorun.inf"
Set objFile = objFSO.CreateTextFile(outFile,True)
objFile.Write "test string" & vbCrLf
objFile.Close
However, I have no idea how to actually implement this. Is the outFile the location and name of the file to be created? I believe it is. But then what is the purpose of objFile.Write "test string" & vbCrLf? My main question is: What am I meant to be telling the created FileSystemObject to process based on the code below?
Dim request, oXMLHttp, url
url = "http://ws.cdyne.com/phoneverify/phoneverify.asmx"
request = "<?xml version='1.0' encoding='utf-8'?>" & _
"<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">" & _
"<soap:Body>" & _
"<CheckPhoneNumbers xmlns=""http://ws.cdyne.com/PhoneVerify/query"">" & _
"<PhoneNumbers>" & _
"<string >1</string>" & _
"<string >2</string>" & _
"<string >3</string>" & _
"<string >4</string>" & _
"<string >5</string>" & _
"<string >6</string>" & _
"<string >7</string>" & _
"<string >8</string>" & _
"<string >9</string>" & _
"<string >10</string>" & _
"</PhoneNumbers>" & _
"<LicenseKey>Key</LicenseKey>" & _
"</CheckPhoneNumbers>" & _
"</soap:Body>" & _
"</soap:Envelope>"
Set oXMLHttp = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHttp.open "POST", url, False
oXMLHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
oXMLHttp.send request
response = oXMLHttp.responseText
MsgBox oXMLHttp.responseText
Create a FileSystemObject:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Use it to create a TextStream object representing the file you want to create (see here for the CreateTextFile function):
Set objFile = objFSO.CreateTextFile("c:\yourfile.txt", True)
Use the TextStream object (objFile) to write text to your new file:
objFile.Write "some text"
In your case, it looks like you'll want to write the HTTP response:
objFile.Write oXMLHttp.responseText
Close your file:
objFile.Close