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