url checker VBA, when redirected, show redirected

Question

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.

Answer 1

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