VBA setRequestHeader "Authorization" failing
Per the Microsoft docs, the JScript example, it looks like authentication requires two sucessive Open
/Send
pairs on the same connection. The first tells the HTTP request object that Digest authentication is required, and the second actually does it. Try this (not tested):
Sub digest()
Dim http As WinHttpRequest ' *** Not "New" - you do it below
Dim strResponse As String
Set http = New WinHttpRequest
http.Open "GET", "http://qrdweb/mg/loan/loans.html?show=all", False
http.Send ' *** Try it without authentication first
if http.Status <> 401 then Exit Sub ' *** Or do something else
http.Open "GET", "http://qrdweb/mg/loan/loans.html?show=all", False
' *** Another Open, same as the JScript example
http.SetCredentials "login123", "pass123", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
http.Send
MsgBox CStr(http.Status) & ": " & http.StatusText ' *** Just to check
Sheets("Sheet1").Cells(1, 1).Value = http.getAllResponseHeaders
Sheets("Sheet1").Cells(1, 2).Value = http.ResponseText
' *** Not sure what these two lines are for --- I have commented them out
'http.Open "PROPFIND", "http://qrdweb/mg/loan/loans.html?show=all", False
'http.send
End Sub
Patrickll
Updated on June 04, 2022Comments
-
Patrickll almost 2 years
I am trying to connect to a Web Database with the following code, but it does not seem to work when automated in VBA. The login and password are fine as I can connect manually with them.
is it possible that the Object: "WinHttp.WinHttpRequest.5.1" does not work with this sort of database connection? Or maybe am I missing a parameter in my Connect sub? Any help on this matter would be greatly appreciated.
Sub Connect() Dim oHttp As Object Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1") Call oHttp.Open("GET", "http://qrdweb/mg/loan/loans.html?show=all", False) oHttp.setRequestHeader "Content-Type", "application/xml" oHttp.setRequestHeader "Accept", "application/xml" oHttp.setRequestHeader "Authorization", "Basic " + Base64Encode("login123" + ":" + "pass123") Call oHttp.send Sheets("Sheet1").Cells(1, 1).Value = oHttp.getAllResponseHeaders Sheets("Sheet1").Cells(1, 2).Value = oHttp.ResponseText End Sub Private Function Base64Encode(sText) Dim oXML, oNode Set oXML = CreateObject("Msxml2.DOMDocument.3.0") Set oNode = oXML.createElement("base64") oNode.DataType = "bin.base64" oNode.nodeTypedValue = StringToBinary(sText) Base64Encode = oNode.Text Set oNode = Nothing Set oXML = Nothing End Function Private Function StringToBinary(Text) Const adTypeText = 2 Const adTypeBinary = 1 Dim BinaryStream Set BinaryStream = CreateObject("ADODB.Stream") BinaryStream.Type = adTypeText BinaryStream.Charset = "us-ascii" BinaryStream.Open BinaryStream.WriteText Text 'Change stream type To binary BinaryStream.Position = 0 BinaryStream.Type = adTypeBinary 'Ignore first two bytes - sign of BinaryStream.Position = 0 StringToBinary = BinaryStream.Read Set BinaryStream = Nothing End Function
The oHttp.getAllResponseHeaders displaying the getAllresponseHeaders outputs the following information:
Cache-Control: must-revalidate,no-cache,no-store
Connection: keep-alive
Date: Fri, 24 Feb 2017 17:19:54 GMT
Content-Length: 30633
Content-Type: text/html;charset=ISO-8859-1
Server: nginx/1.11.6
WWW-Authenticate: Digest realm="QRDWEB-MNM", domain="", nonce="aB5DLmvuCfok9Zo112jo4S0evgOuXntE", algorithm=MD5, qop="auth", stale=true
While the oHttp.ResponseText displaying the ResponseText outputs the following information:
<html> <head> <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/> <title>Error 401 Server Error</title> </head> <body>
Edit 1
When I comment out the 3 lines of code containing: oHttp.setRequestHeader, and changing the line: Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1") by Set oHttp = CreateObject("MSXML2.XMLHTTP"), a pop up appears for a login and password. If I fill in the information the following responses are different:
The oHttp.getAllResponseHeaders displaying the getAllresponseHeaders outputs the following information:
Server: nginx/1.11.6
Date: Fri, 24 Feb 2017 18:19:02 GMT
Transfer-Encoding: chunked
Connection: keep-alive
While the oHttp.ResponseText displaying the ResponseText outputs the following information:
<html> <head> <title>M&M - Loan Viewer</title> <script language="javascript" type="text/javascript"> function showTransactionComments(loanId, date, type, commentsTableWidth) { //alert(loanId + " " + date + " " + type + " " + commentsTableWidth); if (window.ActiveXObject) { return;
Edit 2
I am now attempting to integrate Digest Authentication into VBA with the following sub and I get 2 possible outcomes: The first outcome is the same 401 error when using the wrong login info and the return is immediate. However, when I provide the proper login info, the operation times out... What could be causing that?
Sub digest() Dim http As New WinHttpRequest Dim strResponse As String Set http = New WinHttpRequest http.Open "GET", "http://qrdweb/mg/loan/loans.html?show=all", False http.SetCredentials "login123", "pass123", HTTPREQUEST_SETCREDENTIALS_FOR_SERVER http.send Sheets("Sheet1").Cells(1, 1).Value = http.getAllResponseHeaders Sheets("Sheet1").Cells(1, 2).Value = http.ResponseText http.Open "PROPFIND", "http://qrdweb/mg/loan/loans.html?show=all", False http.send End Sub