Accessing webservice with credentials using vba - vba

Question

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?

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