excelvbahttp-redirecthttprequest

Excel VBA macro for URL redirect detecting returns 200 instead of 301 sometimes


Column B contains the URLs
Column C is intended output for whether it's valid or not, or if it's a redirect
Column D, if it is a redirect, is what URL it redirects to

The following macro works well except there are occasional false positives. I found a few examples: https://www.samsung.com/us/support/troubleshooting/TSG01003149/ https://www.samsung.com/us/support/answer/ANS00080450/ https://www.samsung.com/us/support/troubleshooting/TSG01108764/

I expect these to be redirects but the macro outputs 200 for these for some reason. Why?

Here's the macro:

Sub CheckURLValidity()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim url As String
    Dim httpRequest As Object
    Dim responseCode As Long

    Set ws = ActiveSheet

    ' Find the last row with data in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Create an HTTP request object
    Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    httpRequest.Option(WinHttpRequestOption_EnableRedirects) = False

    For i = 2 To lastRow
        url = ws.Cells(i, 2).Value
        
        ' Check if the URL is empty
        If Len(url) > 0 Then
            httpRequest.Open "GET", url, False
            httpRequest.Send
            
            responseCode = httpRequest.Status

            ' Check the response code
            Select Case responseCode
                Case 200
                    ws.Cells(i, 3).Value = "200 Valid"
                Case 404
                    ws.Cells(i, 3).Value = "404 Not Found"
                Case 301
                    ws.Cells(i, 3).Value = "301 Moved Permanently"
                    ws.Cells(i, 4).Value = httpRequest.getResponseHeader("Location")
                Case 302
                    ws.Cells(i, 3).Value = "302 Found"
                    ws.Cells(i, 4).Value = httpRequest.getResponseHeader("Location")
                Case 307
                    ws.Cells(i, 3).Value = "307 Temporary Redirect"
                    ws.Cells(i, 4).Value = httpRequest.getResponseHeader("Location")
                Case 308
                    ws.Cells(i, 3).Value = "308 Permanent Redirect"
                    ws.Cells(i, 4).Value = httpRequest.getResponseHeader("Location")
                Case Else
                    ws.Cells(i, 3).Value = responseCode & " - Other"
                    ws.Cells(i, 4).Value = httpRequest.getResponseHeader("Location")
            End Select
        End If
    Next i

    Set httpRequest = Nothing
End Sub

I've tried both true and false in this line, doesn't seem to make a difference:

httpRequest.Option(WinHttpRequestOption_EnableRedirects) = False

What am I doing wrong and/or how can I update the macro to detect these redirects correctly?


Solution

  • You're using late binding, so Excel VBA has no idea what WinHttpRequestOption_EnableRedirects represents: it's seen as an undeclared variable and assigned a default value of zero.

    Add

    Const WinHttpRequestOption_EnableRedirects = 6 
    

    to the top right below Sub CheckURLValidity()

    Also - use Option Explicit at the top of every module so this will get flagged up for you.