Accessing webservice with credentials using vba

问题

I'm working on a longer script for Access and at one point it is necessary to check a webservice for the latest version of a file (the filename). This webservice is only accessible via a browser with an URL like https://webservice.example.com:1234/Server/test.jsp?parameter=value then it is necessary to authenticate with the standard browser username password pop up. Of course I could skip this pop up if I'd use something like https://user:password@webservice.example.com:1234/Server/test.jsp?parameter=value instead. (Note that it is not about security at this point the password only exists for the sake of having a password and it's totally acceptable to store it as clear text)

At the moment I already use the following working code to get information from another website:

Dim appIE As Object
Dim sURL as String, infoStr as String
Set appIE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") 'class id of InternetExplorerMedium
sURL = "https://webservice.example.com:1234/Server/test.jsp?parameter=value"
With appIE
    .Navigate sURL
    .Visible = False
End With

Do While appIE.Busy Or appIE.ReadyState <> 4
    DoEvents
Loop

infoStr = appIE.Document.getElementsByTagName("body").item.innerText

However, if I add the credentials to the URL as I would do in the browser sURL = "https://user:password@webservice.example.com:1234/Server/test.jsp?parameter=value" I will get the following error:

Runtime error '-2146697202 (800c000e)': method 'navigate' of object 'IWebBrowser2' failed

Does anybody know why it is failing if I add the credentials or has anybody an idea how to do this differently?

回答1:

If your website requires Basic authentication, it's relatively easy to authenticate using a basic authentication header.

We need to be able to Base64 encode content, so first we need to define a helper function for that:

Public Function ToBase64(Bytes() As Byte) As String
    Dim XMLElement As Object
    Set XMLElement = CreateObject("Msxml2.DOMDocument.6.0").createElement("tmp")
    XMLElement.DataType = "bin.base64"
    XMLElement.nodeTypedValue = Bytes
    ToBase64 = Replace(XMLElement.Text, vbLf, "")
End Function

Then, a second helper to create a basic authentication header:

Public Function CreateBasicAuthHeader(Username As String, Password As String) As String
    'Assuming ASCII encoding, UTF-8 is harder
    CreateBasicAuthHeader = "Authorization: Basic " & ToBase64(StrConv(Username & ":" & Password, vbFromUnicode))
End Function

A quick validation shows that ?CreateBasicAuthHeader("Aladdin", "OpenSesame") returns Authorization: Basic QWxhZGRpbjpPcGVuU2VzYW1l, which is the expected header according to Wikipedia

Then, you can use this in the Navigate method:

Dim appIE As Object
Dim sURL as String, infoStr as String
Set appIE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}") 'class id of InternetExplorerMedium
sURL = "https://webservice.example.com:1234/Server/test.jsp?parameter=value"
With appIE
    .Navigate sURL, Headers:=CreateBasicAuthHeader("MyUsername", "MyPassword")
    .Visible = False
End With

Do While appIE.Busy Or appIE.ReadyState <> 4
    DoEvents
Loop

infoStr = appIE.Document.getElementsByTagName("body").item.innerText

This assumes that the server either expects ASCII encoding, or your username and password are both only ASCII characters and the server expects UTF-8 encoding.

来源：https://stackoverflow.com/questions/54344019/accessing-webservice-with-credentials-using-vba

标签

vba

ms-access

internet-explorer