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?
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