Проверка гиперссылок в Excel на корректность

'Ôóíêöèÿ âîçâðàùàåò True, åñëè ãèïåðññûëêà êîððåêòíà (âåäåò íà
'ñóùåñòâóþùóþ ñòðàíèöó â èíòåðíåòå), è False - â ïðîòèâíîì ñëó÷àå.
Function TestHyperlink(ByVal h As Hyperlink) As Boolean
    On Error Resume Next
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", h.Address, False
        .send
        TestHyperlink = .statusText = "OK"
    End With
    On Error GoTo 0
End Function

Function TestHyperlink(ByVal h As Hyperlink) As Boolean
    On Error Resume Next 'Включаем обработку ошибок.
    With CreateObject("MSXML2.XMLHTTP")
    'Формируем запрос к веб-странице по методу "GET".
        .Open "GET", h.Address, False
    'Отправляем запрос.
        .send
    'Функция возвращает результат сравнения строки
    'статуса запроса с ключевой фразой "OK".
        TestHyperlink = .statusText = "OK"
    End With
    On Error GoTo 0 'Выключаем обработку ошибок.
End Function
 
Sub Main()
    Dim c As Range
    For Each c In Range("A1:A4")
        c.Offset(, 1) = TestHyperlink(c.Hyperlinks(1))
    Next c
End Sub

Sub TestExcellink()
    Dim El, aLinks, LinkFilePathName
    aLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
    If Not IsEmpty(aLinks) Then
        For Each El In aLinks
            LinkFilePathName = Dir(El)
            If LinkFilePathName = "" Then
                Debug.Print El & " файл отсутствует"
                ' При необходимости можно разорвать связь на отсутствующий файл
                ' ActiveWorkbook.BreakLink name:=El, Type:=xlLinkTypeExcelLinks
            Else
                Debug.Print El & " ОК"
            End If
        Next El
    End If
End Sub

Function TestHyperlink(ByVal h As Hyperlink) As Boolean
    On Error Resume Next 
    With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", h.Address, False
           .send
           TestHyperlink = .statusText = "OK"
    End With
    On Error GoTo 0 
End Function
 
Sub Main()
    Dim c As Range
    For Each c In Range("F2:F5")
        c.Offset(, 1) = TestHyperlink(c.Hyperlinks(1))
    Next c
End Sub

Function TryURLstatus(ByVal URL$) As Long
 On Error Resume Next: URL$ = Replace(URL$, "\", "/")
 Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
 XMLHTTP.Open "GET", URL, "False"
 XMLHTTP.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
 XMLHTTP.send
 TryURLstatus = Val(XMLHTTP.Status)
 Set XMLHTTP = Nothing
End Function