Hey guys. This is my first post here. My question is pretty simple and it's been asked before, but mine has a tad bit of a twist.
I have an excel worksheet with column A holding a list of 900 non-clickable text hyperlinks (they can be clickable or not clickable hyperlinks, doens't matter to me).
Example: http://microsoft.com
I've got code that will check the hyperlinks to see if they are valid and it works. The only problem is all the hyperlinks show a status code of 200, OK. Even if I place a test hyperlink http://ghghfdjrj5767.com is comes up OK. I belive the reason for this is the redirect custom error page from our internet provider Cox Communications.
What I need is a way to not get 200, OK returned from a BAD/invalid hyperlink. I'd like to get a redirect status or the classic 404 status returned.
Here is the VBA code I'm using on the spreadsheet.
Thank you in advance for your help!
Todd
I have an excel worksheet with column A holding a list of 900 non-clickable text hyperlinks (they can be clickable or not clickable hyperlinks, doens't matter to me).
Example: http://microsoft.com
I've got code that will check the hyperlinks to see if they are valid and it works. The only problem is all the hyperlinks show a status code of 200, OK. Even if I place a test hyperlink http://ghghfdjrj5767.com is comes up OK. I belive the reason for this is the redirect custom error page from our internet provider Cox Communications.
What I need is a way to not get 200, OK returned from a BAD/invalid hyperlink. I'd like to get a redirect status or the classic 404 status returned.
Here is the VBA code I'm using on the spreadsheet.
Code:
Sub CheckHyperlinks()
Dim oColumn As Range
Set oColumn = GetColumn() ' replace this with code to get the relevant column
Dim oCell As Range
For Each oCell In oColumn.Cells
If Trim(oCell.Value) <> "" Then
oCell.Offset(0, 1).Value = GetResult(oCell.Value)
End If
Next oCell
End Sub
Private Function GetResult(ByVal strUrl As String) As String
On Error GoTo ErrorHandler
Dim oHttp As New MSXML2.XMLHTTP30
oHttp.Open "HEAD", strUrl, False
oHttp.send
GetResult = oHttp.Status & " " & oHttp.statusText
Exit Function
ErrorHandler:
GetResult = "Error: " & Err.Description
End Function
Private Function GetColumn() As Range
Set GetColumn = ActiveWorkbook.Worksheets(1).Range("A2:A1000")
End Function
Thank you in advance for your help!
Todd