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
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!