Question

我有一大堆超链接（加上一些无意义的单元格），我需要检查。我需要知道哪些链接仍处于活动状态，哪些链接不再存在或返回404（或其他）错误。我一直在使用此条目中的建议：Sort dead hyperlinks in Excel with VBA?并且它在一小部分链接中运行良好，其中一些我故意打破了自己。但是，现在我尝试在我的实际超链接列表中使用相同的宏，它根本不起作用！我手动检查了一些，发现404错误的链接。再一次，当我故意错误地输入其中一个地址时，它会选择那个地址，但是它不会在已经破坏的列表中找到任何地址。

我对宏来说是全新的，我真的在黑暗中磕磕绊绊。任何帮助/建议将非常感谢！

Answer 1

我已经使用了一段时间，它一直在为我工作。

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

Answer 2

指定实际地址代替 alink 或将 alink 定义为包含网址的变量。

Answer 3

缺少变量定义，下面是工作代码的URL

Dim alink As Hyperlink
Dim strURL As String
Dim objhttp As Object

Bulk Url checker macro excel

Answer 4

我一直在使用上面建议的代码。我必须对其进行进一步调整，以使其能够像我在Excel电子表格中一样区分URL和File。它对我的特定电子表格来说效果很好，其中包含约50个文件和URL链接。

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

Dim alink As Hyperlink
Dim strURL As String
Dim objhttp As Object
Dim count As Integer

On Error Resume Next
count = 0                                       'used to track the number of non-working links
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               'if url does exist
        alink.Parent.Interior.ColorIndex = 0        'clear cell color formatting
    ElseIf objhttp.statustext <> "OK" Then          'if url doesn't exist
        If Dir(strURL) = "" Then                    'check if the file exists
            alink.Parent.Interior.Color = 255       'set cell background to red its not a valid file or URL
            count = count + 1                       'update the count of bad cell links
        Else
            alink.Parent.Interior.ColorIndex = 0    'clear cell color formatting
        End If
    End If

Next alink
Application.StatusBar = False

'Release objects to prevent memory issues
Set alink = Nothing
Set objhttp = Nothing
On Error GoTo 0
MsgBox ("Checking Complete!" & vbCrLf & vbCrLf & count & " Cell(s) With Broken or Suspect Links. Errors are Highlighted in RED.")

End Sub

我希望这对别人有所帮助，对我有所帮助...每天都好一点！

检查Excel中是否存在损坏的超链接

4 个答案: