I have created a macro to get hyperlink text and address whether it’s internal or external in document and help to open the link to check the content of the link.

However, I’m encounter an issue where some link show popup as “Microsoft Word Security Notice this location might be unsafe.” In this case I couldn’t find anything to bypass or surpass this popup. Other than that, when I click Yes/No or OK in the popup, i will receive debug error Command Failed at ObjHyperlink.Follow.

Is there any way we can disable this kind of popup or bypass them using VBA? I know in excel we can use Application.DisplayAlerts = False but seems like I can’t make it work using this in Word.

Here is my current script.

Sub Hyperlinks_Ori_Bookmark_Testing()
   Dim doc As Object
   Dim objDoc As Object
   Dim objHyperlink As Object
   Dim hyperlinkAddress As String
   Dim hyperlinkedText As String
   Dim i As Integer
   Dim field As Object
   Dim bmName As String
   Dim bm As Bookmark
   Dim isBroken As Boolean
   Dim brokenLinks As String
   Dim shape As Object
   Dim shapeHyperlink As Object
    Dim FILEURL As String
   
      FILEURL = InputBox("Please enter the URL of the Word file on SharePoint:", "Select SharePoint File")
   If FILEURL = "" Then
       Exit Sub
   End If
   
   Dim desktopURL As String
   desktopURL = "ms-word:ofe|u|" & FILEURL
   On Error Resume Next
   ThisWorkbook.FollowHyperlink Address:=desktopURL
   
   Application.Wait Now + TimeValue("0:00:10")
   
 If Err.Number <> 0 Then
   MsgBox "Unable to open the file. Error: " & Err.Description & ". Please check the URL and try again.", vbCritical
   Err.Clear
Else
   ' Get the Word application object
   Set objWord = GetObject(, "Word.Application")
   If objWord Is Nothing Then
       MsgBox "Word application is not running or is not installed."
       Exit Sub
   End If
   
   ' Set the active document to objDoc
   Set objDoc = objWord.ActiveDocument
End If
On Error GoTo 0
   
   i = 3
   With objDoc
       ' Check regular hyperlinks
       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("B" & i).Value = hyperlinkAddress
                   Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("C" & i).Value = "Internal"
                   On Error Resume Next
                   objHyperlink.Follow
                   If Err.Number <> 0 Then
                       Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("D" & i).Value = "Link not OK!"
                       Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("A" & i & ":D" & i).Font.Color = RGB(255, 0, 0)
                       Err.Clear
                   Else
                       Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("D" & i).Value = "Link OK!"
                   End If
                   On Error GoTo 0
               Else
                   hyperlinkAddress = objHyperlink.Address
                   Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("B" & i).Value = hyperlinkAddress
                   Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("C" & i).Value = "External"
                   objHyperlink.Follow
                    SelectionInterface.Show
                    If SelectionInterface.Tag = "LinkOK" Then
                        Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("D" & i).Value = "Link OK!"
                    ElseIf SelectionInterface.Tag = "LinkNotOK" Then
                        Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("D" & i).Value = "Link not OK!"
                        Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("A" & i & ":D" & i).Font.Color = RGB(255, 0, 0)
                    ElseIf SelectionInterface.Tag = "NoAccess" Then
                        Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("D" & i).Value = "No Access!"
                        Workbooks("Document Hyperlink Checker.xlsm").Sheets("Automation").Range("A" & i & ":D" & i).Font.Color = RGB(255, 0, 0)
                    End If
               End If
           End If
           i = i + 1
       Next objHyperlink