Hello all,

I'm trying to run the following macro but I get an error as given in
the subject line. Please help me to fix the error.

I'm trying to check if the hyperlinks in several cells of a column are
working or dead. Given below is not my code but I found it in the
internet and it suited what I'm trying to do.

Thanks,
Marvin.


Option Explicit

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 oCell.Hyperlinks.Count 0 Then

Dim oHyperlink As Hyperlink
Set oHyperlink = oCell.Hyperlinks(1) ' I assume only 1
hyperlink per cell

Dim strResult As String
strResult = GetResult(oHyperlink.Address)

oCell.Offset(0, 1).Value = strResult

End If
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("A:A")
End Function

Private Sub CommandButton1_Click()
Call CheckHyperlinks
End Sub