excelvbahttp-head

Why does this HTTP head request not work in Excel VBA?


I need to detect whether a URL is served as is or redirects. A StackOverflow answer told me this can be done by making an HTTP head request and watching for the response code. If the URL is served as is, then the request should return the success code, 200. But if it redirects, then the request should return the redirect code, 303.

I'm not familiar with HTTP requests, and ChatGPT has told me before that it can write code for me, so I gave it a try, asking, "How do I make a HEAD HTTP request in Excel VBA?" It gave me a VBA subroutine, which I converted to the following function:

Public Function nHeadRequest(sURL As String) as Integer

On Error Resume Next

Dim oXmlHttp As Object, nRetVal As Integer
Set oXmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
oXmlHttp.followRedirects = True

oXmlHttp.Open "HEAD", sURL, False
oXmlHttp.setRequestHeader "Content-Type", "text/xml"
oXmlHttp.send ""
nRetVal = oXmlHttp.Status

Set oXmlHttp = Nothing

On Error GoTo 0

nHeadRequest = nRetVal

End Function        ' nHeadRequest()

I call this function in Excel with the formula =nHeadRequest(<URL>). I've tested this with the following three URLs:

Instead of those anticipated results, I get 200 for both of the first two URLs. For the third URL, I get 0, which I presume is not a status code, but is the result of the request encountering an error when accessing the bad URL and following the on error resume next command.

So I suspect there's a problem in the code ChatGPT gave me. I've heard that ChatGPT can also help with debugging code, so I told it about the incorrect results. It suggested some changes, but nothing that fixed the code.

So, can someone say what's wrong with the above code?


Solution

  • Track redirection with WinHttp.WinHttpRequest.5.1

    Public Function nHeadRequest(sURL) As Integer
        Const WHR_EnableRedirects = 6
        Dim oXmlHttp As Object, nRetVal As Integer
        Set oXmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
        oXmlHttp.Option(WHR_EnableRedirects) = False
        oXmlHttp.Open "HEAD", sURL, False
        oXmlHttp.setRequestHeader "Content-Type", "text/xml"
        On Error Resume Next
        oXmlHttp.send ""
        If Err.Number = 0 Then
            nRetVal = oXmlHttp.Status
        Else
            nRetVal = -9999
        End If
        On Error GoTo 0
        Set oXmlHttp = Nothing
        nHeadRequest = nRetVal
    End Function
    
    Sub demo()
        Dim sU As String
        sU = "https://www.youtube.com/shorts/w3-yM1IjuB0"
        Debug.Print (nHeadRequest(sU))
        sU = "https://www.youtub.com"
        Debug.Print (nHeadRequest(sU))
    End Sub