Excel VBA 脚本在 URL 列表中查找 404 错误？

Question

所以，我有一个包含大约 5000 个 URL 列表的电子表格。 （我们公司内部网上的所有页面。）

我们知道一些链接已损坏，但不知道在不点击全部 5000 个链接的情况下确定哪个链接的好方法。

通常这很简单：创建一个包含 5000 个页面链接的网页，然后使用 Xenu Link Sleuth 等工具检查链接。

但这在这种情况下不起作用，因为许多链接正在被重定向，并且重定向代码欺骗 HTTP.response 200，这会欺骗 Xenu 将其视为有效 URL。

不过，有一些好消息：重定向脚本不在 Excel 中运行。如果单击 Excel 中的错误链接，重定向脚本不会执行，并且 HTTP 响应会报告回 Excel。我相信 Excel 应该能够识别正确的 HTTP 响应代码 (404) - 或者至少该链接是否有效。

这让我想到了我的问题：

有没有办法使用 VBA 编写一个脚本来点击每个链接并捕获结果？捕获的结果可以是 HTTP 响应代码的形式，也可以是您认为有助于在 5000 个页面列表中找到错误链接的任何其他形式。理想情况下，结果将写入电子表格中与链接相邻的单元格中。

如果有足够熟悉 VBA 的人提出解决此问题的方法，我将不胜感激！

Answer 1

使用用户定义的函数返回 HTML 状态代码并将其拖到链接旁边。不过，Excel 可能需要一段时间才能检查 5000 个链接。

Public Function CheckURL(url As String) As String
Dim request As New WinHttpRequest
request.Open "GET", url
request.Send
CheckURL = request.Status
End Function

您可能需要在“Extras”->“References”下添加对“Microsoft WinHTTP Services”的引用

Answer 2

这是一个使用 Excel 从 URL 列表中检查状态行的示例：

Sub TestLinks()
  Dim source As Range, req As Object, url$
  Set req = CreateObject("Msxml2.ServerXMLHTTP.6.0")

  ' define were the links and results are
  Set source = Range("A1:B2")

  ' clear the results
  source.Columns(2).Clear

  ' iterate each row
  For i = 1 To source.Rows.count
    ' get the link from the first column
    url = source.Cells(i, 1)

    ' send the request using a HEAD to check the status line
    req.Open "HEAD", url, False
    req.setRequestHeader "Accept", "image/webp,image/*,*/*;q=0.8"
    req.setRequestHeader "Accept-Language", "en-GB,en-US;q=0.8,en;q=0.6"
    req.setRequestHeader "Accept-Encoding", "gzip, deflate"
    req.setRequestHeader "Cache-Control", "no-cache"
    req.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
    req.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/47.0.2526.111 Safari/537.36"
    req.Send

    ' write the result in the second column
    source.Cells(i, 2) = req.Status
  Next

  MsgBox "Finished!"
End Sub