I’ve created a simple script to extract all hyperlink addresses from a Word document to check whether the links are accessible or broken. Sometimes, the hyperlink itself works perfectly, but the content it points to is broken. For instance, when I open the link, it might display messages like “Hmmm… can’t reach this page” or “Sorry, something went wrong, No item exists at”. In such cases, the link works, but the content is not accessible.
Is it possible to detect these kinds of links and consider them broken?
Thank you.

My full code

    Sub Hyperlinks()
   Dim FILEPATH As String
   Dim doc As Object
   Dim objDoc As Object
   Dim objHyperlink As Object
   Dim hyperlinkAddress As String
   Dim hyperlinkedText As String
   Dim status As String
   FILEPATH = Application.GetOpenFilename("Word Files (*.docx; *.doc), *.docx; *.doc", , "Please Select a Word File")
   If FILEPATH = "False" Then Exit Sub
   If FILEPATH <> "False" Then
       Set doc = CreateObject("Word.Application")
       doc.Visible = True
       Set objDoc = doc.Documents.Open(FILEPATH)
   End If
   Dim i As Integer
   i = 3
   With objDoc
       For Each objHyperlink In .Hyperlinks
           hyperlinkedText = objHyperlink.Range.Text
           Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("A" & i).Value = hyperlinkedText
           If objHyperlink.Address <> "" Or objHyperlink.SubAddress <> "" Then
               If objHyperlink.SubAddress <> "" Then
                   hyperlinkAddress = objHyperlink.SubAddress
                   Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("C" & i).Value = "Internal"
               Else
                   hyperlinkAddress = objHyperlink.Address
                   Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("C" & i).Value = "External"
               End If
               Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("B" & i).Value = hyperlinkAddress
               If InStr(1, hyperlinkAddress, "http", vbTextCompare) > 0 Then
                   status = CheckHyperlink(hyperlinkAddress)
               Else
                   status = "N/A"
               End If
               Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("D" & i).Value = status
           Else
               Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("B" & i).Value = hyperlinkAddress
           End If
           i = i + 1
       Next objHyperlink
   End With
   MsgBox ("Checking Completed")
End Sub
Function CheckHyperlink(url As String) As String
   Dim http As Object
   Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
   On Error GoTo ErrorHandler
   http.Open "GET", url, False
   http.send
   If http.status = 200 Then
       CheckHyperlink = "Valid"
   Else
       CheckHyperlink = "Broken"
   End If
   Exit Function
ErrorHandler:
   CheckHyperlink = "Broken"
End Function

Some screenshot :