VBA - WinHTTP Authentication on redmine failed - vba

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!

Related

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

Convert file to binary and send to API

I have VBA script in Outlook 2019, for sending datas to API and store in MYSQL database. But in my case need Outlook atachment convert to binary file and send to API.
VBA Script for sending datas to APi:
Dim SendDataToApi As String
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = "https://url.domain.com/api/dataInsert"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
SendDataToApi = "mail_from=" & strFrom & "&mail_to=" & strFrom & "&mobile_phone=123456789&date_send=2020-05-14&date_expiration=2020-05-15"
objHTTP.Send SendDataToApi
VBA script for 7zip all atechment to one file:
For Each objAttachment In objMail.Attachments
objAttachment.SaveAsFile cstrFileAttachment & objAttachment.FileName
Next objAtachment
strSource = cstrFolderAttachment & "*.*"
strDestination = cstrFolderAttachment & "Zip\attachment.zip"
strCommand = """" & PathZipProgram & """ a -tzip """ & strDestination & _
""" -p" """ & strSource & """"
This moment i have all attachments from mail saved in 7zip in local folder. My goal is convert this 7zip file to binary file and send to API together with rest of this code:
SendDataToApi = "mail_from=" & strFrom & "&mail_to=" & strFrom & "&mobile_phone=123456789&date_send=2020-05-14&date_expiration=2020-05-15" is possible to achive this ?

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 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

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.