VBA setRequestHeader "Authorization" failing

Question

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

It looks to me like the server wants Digest authentication (`WWW-Authenticate: Digest`). You are providing Basic authentication, which the server may not be willing to accept. Have you tried using Digest in your VBA code? I found [this link](https://github.com/VBA-tools/VBA-Web/blob/master/authenticators/DigestAuthenticator.cls) which looks like it might be useful. — cxw, Feb 24 '17 at 19:06
Hi, thanks for the direction. I have no experience with Digest authentication. I am researching the topic as we speak. — Patrickll, Feb 24 '17 at 19:38
Update on connexion: I am currently trying a new form of login (see below) and i get 2 possible outcomes: The first outcome is the same 401 error when using the wrong loging info and the return is immediate. However, when i provide the proper login info, the operation times out... What could be causing that? — Patrickll, Feb 24 '17 at 21:48
Code: 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 End Sub — Patrickll, Feb 24 '17 at 21:49

score 1 · Answer 1 · answered Feb 27 '17 at 19:58

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

VBA setRequestHeader "Authorization" failing

Edit 1

Edit 2

1 Answers1