url checker VBA，当重定向时，显示重定向的url [英] url checker VBA, when redirected, show redirected url

问题描述

我非常喜欢EXCEL VBA，而且我很难找到一种方法来创建一个MACRO，显示一个url是否仍然有效（200 OK），
或者可能被重定向，如果是这样，我想知道什么URL。当它不工作时，然后返回正确的代码，原因是URL不起作用。

所以目前我有一个实际工作的脚本，它不会返回url被重定向到的url。
当url仍然处于活动状态或原始URL被重定向到的url仍然有效时，它只返回（200 OK）。所以我知道哪些网址已经死了，或被重定向到一个死URL。

但是我想再走一步。
由于我想检查的URL目前位于A列，结果返回B列，我想查看我在C中被重定向到的URL列，每次有URL被重定向。

我确实在网上找到了一些应该做这个工作的功能，但是由于某种原因我无法适应我们的SUB。像我之前提到的，这对我来说都是新的。

这是我现在所在的：

  Sub CheckHyperlinks（）
 
 Dim oColumn As Range 
将oColumn = GetColumn（）替换为代码以获取相关列
 
 Dim oCell As Range 
对于每个oCell在oColumn.Cells 
 
如果oCell.Hyperlinks.Count> 0然后
 
 Dim oHyperlink作为超链接
设置oHyperlink = oCell.Hyperlinks（1）我假设每个单元格只有一个超链接
 
 Dim strResult As String 
 strResult = GetResult（oHyperlink.Address）
 
 oCell.Offset（0，1）.Value = strResult 
 
 
如果
 
下一个oCell 
 
 
 End Sub 
 
私有函数GetResult（ByVal strUrl As String）As String 
 
错误GoTo ErrorHandler 
 
 Dim oHttp As New MSXML2.ServerXMLHTTP30 
 
 oHttp.OpenHEAD，strUrl，False 
 oHttp.send 
 
 GetResult = oHttp状态& & oHttp.statusText 
 
退出函数
 
 ErrorHandler：
 GetResult =Error：& Err.Description 
 
结束功能
  

我希望你们中的一个可以帮助我

解决方案

最好使用WinHttp COM对象。这将让您禁用重定向处理。

 公共函数GetResult（ByVal strUrl As String，Optional ByRef isRedirect As Boolean，可选ByRef target As String）As String 
 Dim oHttp As New WinHttp.WinHttpRequest 
 
 oHttp.Option（WinHttpRequestOption_EnableRedirects）= False 
 oHttp.OpenHEAD，strUrl，False 
 oHttp.send 
 GetResult = oHttp状态& & oHttp.statusText 
如果oHttp.Status = 301或oHttp.Status = 302然后
 isRedirect = True 
 target = oHttp.getResponseHeader（Location）
 Else 
 isRedirect = False 
 target = Nothing 
如果
结束函数
  

I'm quite new to EXCEL VBA's and I'm kinda stuck finding a way to create a MACRO that shows whether a url is still active (200 ok), or may be redirected, and if so, I want to know to what URL. And when it's not working at all, then return the right code with the reason the URL isn't working.

So at the moment I have a script that actually works but it doesn't return the url to which an url is redirected to. It only returns (200 OK) when an url is still active, or the url that the original url has been redirected to is still active. So I know which URLs are dead or are redirected to a dead URL.

But I want to take it a step futher. As the URLs that I want to check are in the "A" column at the moment, and the results return in the "B" column, I want to see the URL to which I've been redirected in the C column, everytime there an URL has been redirected.

I did find some functions online that should do the job but for some reason I can't fit them in my SUB. Like I mentioned before, it's all quite new to me.

This is what I have at the moment:

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

I hope one of you could help me out.

解决方案

Its better to use the WinHttp COM object. That will let you "disable" redirect handling. Read this forum post. The component you need to reference is Microsoft WinHTTP Services.

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

这篇关于url checker VBA，当重定向时，显示重定向的url的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！