Checking for broken hyperlinks in Excel

Question

I have a large list of hyperlinks (plus a few cells of nonsense) that I need to check. I need to know which links are still active and which no longer exist or return a 404

Answer 1

Specify an actual address in place of alink or define alink as a variable which contains a web address.

Answer 2

I have been using the suggested code above. I had to adapt it further so that it can differentiate between a URL and a File as I have both in my excel spreadsheet. It works well for my particular spreadsheet with about 50 links to files and URLs.

Sub Audit_WorkSheet_For_Broken_Links()

If MsgBox("Is the Active Sheet a Sheet with Hyperlinks You Would Like to Check?", vbOKCancel) = vbCancel Then

    Exit Sub

End If

Dim alink As Hyperlink
Dim strURL As String
Dim objhttp As Object
Dim count As Integer

On Error Resume Next
count = 0                                       'used to track the number of non-working links
For Each alink In Cells.Hyperlinks
    strURL = alink.Address

    If Left(strURL, 4) <> "http" Then
        strURL = ThisWorkbook.BuiltinDocumentProperties("Hyperlink Base") & strURL
    End If

    Application.StatusBar = "Testing Link: " & strURL
    Set objhttp = CreateObject("MSXML2.XMLHTTP")
    objhttp.Open "HEAD", strURL, False
    objhttp.Send
    If objhttp.statustext = "OK" Then               'if url does exist
        alink.Parent.Interior.ColorIndex = 0        'clear cell color formatting
    ElseIf objhttp.statustext <> "OK" Then          'if url doesn't exist
        If Dir(strURL) = "" Then                    'check if the file exists
            alink.Parent.Interior.Color = 255       'set cell background to red its not a valid file or URL
            count = count + 1                       'update the count of bad cell links
        Else
            alink.Parent.Interior.ColorIndex = 0    'clear cell color formatting
        End If
    End If

Next alink
Application.StatusBar = False

'Release objects to prevent memory issues
Set alink = Nothing
Set objhttp = Nothing
On Error GoTo 0
MsgBox ("Checking Complete!" & vbCrLf & vbCrLf & count & " Cell(s) With Broken or Suspect Links. Errors are Highlighted in RED.")

End Sub

I hope this helps someone else as much as it has helped me... A little better everyday!

Answer 3

I've been using this for a while and it has been working for me.

Sub Audit_WorkSheet_For_Broken_Links()

If MsgBox("Is the Active Sheet a Sheet with Hyperlinks You Would Like to Check?", vbOKCancel) = vbCancel Then

    Exit Sub

End If

On Error Resume Next
For Each alink In Cells.Hyperlinks
    strURL = alink.Address

    If Left(strURL, 4) <> "http" Then
        strURL = ThisWorkbook.BuiltinDocumentProperties("Hyperlink Base") & strURL
    End If

    Application.StatusBar = "Testing Link: " & strURL
    Set objhttp = CreateObject("MSXML2.XMLHTTP")
    objhttp.Open "HEAD", strURL, False
    objhttp.Send

    If objhttp.statustext <> "OK" Then

        alink.Parent.Interior.Color = 255
    End If

Next alink
Application.StatusBar = False
On Error GoTo 0
MsgBox ("Checking Complete!" & vbCrLf & vbCrLf & "Cells With Broken or Suspect Links are Highlighted in RED.")

End Sub

Answer 4

variable definitions missing, URL to working code below

Dim alink As Hyperlink
Dim strURL As String
Dim objhttp As Object

Bulk Url checker macro excel