none
How can I check for broken hyperlinks in a Word document using VBA RRS feed

  • Question

  • Hi,

    I am currently using the following code which goes through the document and inserts a list of links, link text and if there is an error opening the page at the end of the document.

    It only picks up if a 404 error is returned and it results in heaps of windows being opened on my computer.  I am sure it will break if there are many links in the Word document.

    Ideally I would like the VBA code to return the HTTP status of the document and perhaps the Title of the web page that is returned and not actually open the document in my browser.

    Can anyone give me some pointers towards approaches or code.

    Thanks in advance,

    Peter Evans    http://eMarkingAssistant.com

    ----

    Private Sub openAllLinks()
        Dim thisHyperlink As Hyperlink
        Dim theResult As String
        theResult = vbCrLf & "---8<----- theresults----" & vbCrLf
        On Error GoTo ErrorHandler
        For Each thisHyperlink In ActiveDocument.Hyperlinks
            If thisHyperlink.Address <> "" And Left(thisHyperlink.Address, 6) <> "mailto" Then
                theResult = theResult & "Testing: " & thisHyperlink.Address & " " & thisHyperlink.TextToDisplay & vbCrLf
                ActiveDocument.FollowHyperlink thisHyperlink.Address
             End If
        Next
        ActiveDocument.Content.InsertAfter theResult
        Exit Sub
       
    ErrorHandler:
        theResult = theResult & "ERROR!: " & thisHyperlink.Address & " " & thisHyperlink.TextToDisplay & vbCrLf
        Resume Next
    End Sub

    Tuesday, May 10, 2016 8:16 AM

Answers

  • Hi, Peter_Evans

    According to your description, you could use the MSXML2.XMLHTTP.Send method to send a request to the server and receive a response, you can check the return state to judge the hyperlinks are valid, refer to below code:
    Function CheckHyperlink(HypelinksAddress As String) As String
    On Error GoTo ErrorHandler
            Dim oHttp As MSXML2.XMLHTTP
            Set oHttp = CreateObject("MSXML2.XMLHTTP")
            oHttp.Open "Get", HypelinksAddress, False
            oHttp.send
            CheckHyperlink = oHttp.Status & " " & oHttp.StatusText
            Exit Function
    ErrorHandler:
           CheckHyperlink = "Error: " & Err.Description
    End Function
    
    Sub Demo()
    
        For Each thisHyperlink In ActiveDocument.Hyperlinks
            Debug.Print CheckHyperlink(thisHyperlink.Address)
        Next
    
    End Sub

    For more information, click here to refer about Referencing MSXML within VBA Projects

    Wednesday, May 11, 2016 1:41 AM
  • >>>I now get the following error in the following line

    oHttp.send <<<

    According to your description, I have downloaded your Word document and reproduced this issue, this issue is caused by that you have commented this line code: "On Error GoTo ErrorHandler". So I suggest that you could modify like below:
    Function CheckHyperlink(HypelinksAddress As String) As String
    On Error GoTo ErrorHandler
            Dim oHttp As MSXML2.ServerXMLHTTP
            Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")
            Debug.Print HypelinksAddress
            oHttp.Open "Get", HypelinksAddress, False
            oHttp.Send
            CheckHyperlink = HypelinksAddress & " " & oHttp.Status & " " & oHttp.StatusText
            Exit Function
    ErrorHandler:
           CheckHyperlink = "Error: " & Err.Description
    End Function

    • Marked as answer by Peter_Evans Sunday, June 5, 2016 11:11 AM
    Friday, June 3, 2016 7:46 AM

All replies

  • Hi, Peter_Evans

    According to your description, you could use the MSXML2.XMLHTTP.Send method to send a request to the server and receive a response, you can check the return state to judge the hyperlinks are valid, refer to below code:
    Function CheckHyperlink(HypelinksAddress As String) As String
    On Error GoTo ErrorHandler
            Dim oHttp As MSXML2.XMLHTTP
            Set oHttp = CreateObject("MSXML2.XMLHTTP")
            oHttp.Open "Get", HypelinksAddress, False
            oHttp.send
            CheckHyperlink = oHttp.Status & " " & oHttp.StatusText
            Exit Function
    ErrorHandler:
           CheckHyperlink = "Error: " & Err.Description
    End Function
    
    Sub Demo()
    
        For Each thisHyperlink In ActiveDocument.Hyperlinks
            Debug.Print CheckHyperlink(thisHyperlink.Address)
        Next
    
    End Sub

    For more information, click here to refer about Referencing MSXML within VBA Projects

    Wednesday, May 11, 2016 1:41 AM
  • Hi David,

    Thanks for your reply but when I set the reference and run your code I get the following error

    on the following line

        oHttp.send

    Can you please assist,

    Peter Evans

    Monday, May 23, 2016 2:11 PM
  • >>>but when I set the reference and run your code I get the following error

    According to your description, I have tried to reproduce this issue, unfortunately, I am not able. So could you figure out whether all hyperlinks or some special hyperlinks cause this issue?

    In addition you could use ServerXMLHTTP instead:
    Dim oHttp As MSXML2.ServerXMLHTTP
    Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")

    Thursday, May 26, 2016 8:02 AM
  • Hi David,

    I now get the following error in the following line

    oHttp.send 

    I'm using Windows 10 with Office Professsional Plus 2013

    You  can download the Word document at the following location to run it on your machine

       https://dl.dropboxusercontent.com/u/18519629/link-checker4.docm

    Thanks in advance for your assistance,

    Peter Evans

    Tuesday, May 31, 2016 1:16 PM
  • >>>I now get the following error in the following line

    oHttp.send <<<

    According to your description, I have downloaded your Word document and reproduced this issue, this issue is caused by that you have commented this line code: "On Error GoTo ErrorHandler". So I suggest that you could modify like below:
    Function CheckHyperlink(HypelinksAddress As String) As String
    On Error GoTo ErrorHandler
            Dim oHttp As MSXML2.ServerXMLHTTP
            Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")
            Debug.Print HypelinksAddress
            oHttp.Open "Get", HypelinksAddress, False
            oHttp.Send
            CheckHyperlink = HypelinksAddress & " " & oHttp.Status & " " & oHttp.StatusText
            Exit Function
    ErrorHandler:
           CheckHyperlink = "Error: " & Err.Description
    End Function

    • Marked as answer by Peter_Evans Sunday, June 5, 2016 11:11 AM
    Friday, June 3, 2016 7:46 AM
  • Thanks for your assistance David.

    Peter Evans

    Sunday, June 5, 2016 11:11 AM