Custom function for checking validity of a hyperlink

[mbt2103]

As the subject says, I'm trying to create a custom function in VBA that will check the validity of a hyperlink. The purpose of this is to have a personnel tracking sheet with hyperlinks to supporting documentation (such as a scan of the employee's diploma) which, when the supporting documentation doesn't exist, display something like "NOT AVAILABLE" in the cell.

All of this is hosted on an internal sharepoint server that is password protected and heavily encrypted, because I work at a healthcare facility. This means that the links are web addresses, not file structure links.

I almost have it working. Here's what I have so far (this requires a reference to Microsoft WinHTTP Services, version 5.1):

Dim oURL As New WinHttpRequestDim linkStatus As Integer


On Error GoTo errorhandler


With oURL
    .Option(WinHttpRequestOption_EnableRedirects) = False
    .Open "POST", link, False
    .Send ("")
    testhyperlink = .ResponseText
    Exit Function
End With


errorhandler:
    testhyperlink = "Error"


End Function

This function works wonderfully for websites that do not require a login (also, I have to mention that it is mostly an adaptation of a macro built by someone on this forum several years back, which I found during my initial search for answers).

For websites that require a login, it ALWAYS returns: "401 UNAUTHORIZED", whether or not the linked item exists.

When I use the HYPERLINK function and click on the link from excel, however, it never asks me for login credentials (I have to login to access the document in the first place), instead, it immediately gives me one of two excel error windows. If the file exists, it says: "Opening [this file] Some files can contain viruses ... Would you like to open this file?" but if the file doesn't exist, it says: "Unable to open [this file]. The internet site reports that the item you requested could not be found. (HTTP/1.0 404)"

If I could capture those windows, I could make it work! But I don't know how ...

Any thoughts?

 

[mbt2103]

Solved.

Add a reference to Microsoft XML, v6.0, then use the following code:

Function testhyperlink(link As String) As Boolean
Dim oURL As New WinHttpRequest
Dim linkStatus As Integer


On Error GoTo errorhandler


Dim linkRequest As Object
Set linkRequest = New MSXML2.XMLHTTP60
With linkRequest
    .Open "GET", link, False
    .SetRequestHeader "Cache-Control", "no-cache"
    .SetRequestHeader "Pragma", "no-cache"
    .SetRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    .Send
End With
testhyperlink = True
If linkRequest.Status = 404 Then testhyperlink = False
Exit Function


errorhandler:
    testhyperlink = False


End Function