url检查器VBA，当redirect时，显示redirect的url

对于EXCEL VBA来说，我是个新手，而且我有点不明白如何创build一个MACRO来显示一个url是否仍然有效（200 OK），或者可能被redirect，如果是的话，我想知道哪个URL 。 而当它不工作，然后返回正确的代码与URL不工作的原因。

所以目前我有一个脚本实际上工作，但它不会返回一个url被redirect到的url。 当url仍处于活动状态时，它只会返回（200 OK），或者原始url已被redirect到的url仍处于活动状态。 所以我知道哪些URL已经死亡或者被redirect到一个死链接。

但我想进一步向前迈进一步。 由于我想检查的url目前位于“A”列，而结果会返回到“B”列，因此我希望在C列中查看我已redirect到的url一个url已被redirect。

我在网上find了一些应该做这个工作的function，但是由于某种原因，我不能把它们放在我的SUB中。 就像我之前提到的那样，这对我来说都是很新鲜的东西。

这是我现在所拥有的：

Sub CheckHyperlinks() Dim oColumn As Range Set oColumn = GetColumn() '' replace this with code to get the relevant column Dim oCell As Range For Each oCell In oColumn.Cells If oCell.Hyperlinks.Count > 0 Then Dim oHyperlink As Hyperlink Set oHyperlink = oCell.Hyperlinks(1) '' I assume only 1 hyperlink per cell Dim strResult As String strResult = GetResult(oHyperlink.Address) oCell.Offset(0, 1).Value = strResult End If Next oCell End Sub Private Function GetResult(ByVal strUrl As String) As String On Error GoTo ErrorHandler Dim oHttp As New MSXML2.ServerXMLHTTP30 oHttp.Open "HEAD", strUrl, False oHttp.send GetResult = oHttp.Status & " " & oHttp.statusText Exit Function ErrorHandler: GetResult = "Error: " & Err.Description End Function 

我希望你们中的一位能够帮助我。

Answer 1

最好使用WinHttp COM对象。 这将让你“禁用”redirect处理。 阅读这个论坛post 。 您需要引用的组件是Microsoft WinHTTP服务 。

 Public Function GetResult(ByVal strUrl As String, Optional ByRef isRedirect As Boolean, Optional ByRef target As String) As String Dim oHttp As New WinHttp.WinHttpRequest oHttp.Option(WinHttpRequestOption_EnableRedirects) = False oHttp.Open "HEAD", strUrl, False oHttp.send GetResult = oHttp.Status & " " & oHttp.statusText If oHttp.Status = 301 Or oHttp.Status = 302 Then isRedirect = True target = oHttp.getResponseHeader("Location") Else isRedirect = False target = Nothing End If End Function