View Full Version : Checking hyperlinks in excel macro

11-02-2010, 04:17 AM
Greetings!! VBA Experts,

Just a thought, whether checking status of hyperlinks is possible in VBA?

Have a excel sheet with links in column A, want to have the status(working,dead,redirect) in column B.

Best Regards,

Sebastian H
11-05-2010, 02:45 PM
Is there a reason why you want to do that in Excel? All Excel gives you in your case is a list of strings, which you can easily read from a text file instead. The rest is done by the browser. Have you considered using VB.NET or any other application independent programming language instead?

Kenneth Hobs
11-05-2010, 09:33 PM
Yes, it is doable. It does take some time though if you have many. I saw a thread at MrExcel 3 days ago that showed how to do it. The method posted did not work for all types of links. The http links are easily done. The thread used the method of winhttp and the Status property. Look for CreateObject("WinHttp.WinHttpRequest.5.1").

If you can't find the thread or need an example, post back.

Sebastian H
11-06-2010, 01:36 PM
Cool - that gives me new ideas for things to do with VBA. :creator:

Kenneth Hobs
11-07-2010, 08:11 AM
Sub Test_IsURLGood()
Dim r As Range, cell As Range
Set r = Range("A1")
Do Until r = Empty
r.Offset(0, 1).Value = IsURLGood(r.Value)
Set r = r.Offset(1)
End Sub

'shg, http://www.mrexcel.com/forum/showthread.php?t=506054
Function IsURLGood(sURL As String) As Variant
' Requires a reference to Microsoft WinHTTP Services

' http://msdn.microsoft.com/en-us/library/aa384081%28v=VS.85%29.aspx
' http://msdn.microsoft.com/en-us/library/aa384106%28v=VS.85%29.aspx
' http://msdn.microsoft.com/en-us/library/aa384072%28v=VS.85%29.aspx
' http://msdn.microsoft.com/en-us/library/aa383887%28v=VS.85%29.aspx

On Error GoTo Oops

With New WinHttpRequest
.Open "GET", sURL

Select Case .Status
Case 200
IsURLGood = IIf(InStr(1, .Option(1), sURL, vbTextCompare) = 1, "OK", False)
Case 403: IsURLGood = "Forbidden"
Case 404: IsURLGood = "Not Found"
Case 410: IsURLGood = "Gone"
Case 503: IsURLGood = "Service Unavailable"
Case Else: IsURLGood = False
End Select
Exit Function
End With

IsURLGood = False
End Function