在 Excel 中检查损坏的超链接答案

【问题标题】：Checking for broken hyperlinks in Excel在 Excel 中检查损坏的超链接
【发布时间】：2014-04-10 23:31:10
【问题描述】：

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

我对宏完全陌生，在这里我真的在黑暗中磕磕绊绊。任何帮助/建议将不胜感激！

【问题讨论】：

标签： excel vba sorting hyperlink

【解决方案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

【讨论】：

我不断收到alink 未定义。
@MCP_infiltrator 然后在循环前加上Dim alink as Hyperlink。答案似乎假设Option Explicit 没有激活。请参阅下面 SomeGuy 的答案。
在我自己的网站网址上对此进行了测试，效果很好。在 stackoverflow.com 上测试，我收到“访问被拒绝”错误

【解决方案2】：

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

【讨论】：

【解决方案3】：

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

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

Bulk Url checker macro excel

【讨论】：

这应该是对答案的评论，而不是答案本身，因为它没有足够清楚地回答问题，尽管答案在链接中。写下来！ :)

【解决方案4】：

我一直在使用上面建议的代码。我必须进一步调整它，以便它可以区分 URL 和文件，就像我在我的 excel 电子表格中一样。它适用于我的特定电子表格，其中包含大约 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

我希望这对其他人有帮助，就像它对我有帮助一样...每天都好一点！

【讨论】：