Checking for broken hyperlinks in Excel

后端 未结 4 1112
隐瞒了意图╮
隐瞒了意图╮ 2020-12-09 23:42

I have a large list of hyperlinks (plus a few cells of nonsense) that I need to check. I need to know which links are still active and which no longer exist or return a 404

4条回答
  •  没有蜡笔的小新
    2020-12-10 00:21

    I've been using this for a while and it has been working for me.

    Sub Audit_WorkSheet_For_Broken_Links()
    
    If MsgBox("Is the Active Sheet a Sheet with Hyperlinks You Would Like to Check?", vbOKCancel) = vbCancel Then
    
        Exit Sub
    
    End If
    
    On Error Resume Next
    For Each alink In Cells.Hyperlinks
        strURL = alink.Address
    
        If Left(strURL, 4) <> "http" Then
            strURL = ThisWorkbook.BuiltinDocumentProperties("Hyperlink Base") & strURL
        End If
    
        Application.StatusBar = "Testing Link: " & strURL
        Set objhttp = CreateObject("MSXML2.XMLHTTP")
        objhttp.Open "HEAD", strURL, False
        objhttp.Send
    
        If objhttp.statustext <> "OK" Then
    
            alink.Parent.Interior.Color = 255
        End If
    
    Next alink
    Application.StatusBar = False
    On Error GoTo 0
    MsgBox ("Checking Complete!" & vbCrLf & vbCrLf & "Cells With Broken or Suspect Links are Highlighted in RED.")
    
    End Sub
    

提交回复
热议问题