Checking URL Status, returning any redirect and setting a timeout

[Deutz]

Hi and thanks in advance,

I have a URL checking function that has been working well for me but, due to a restriction on the use of API calls, will need to be recoded.

Basically, I have a list of URL’s (not links) in column A of a sheet and I want to loop through them and check that they are returning status 200 and then outputting ‘OK’ in column B or if not status = 200 then ‘FAILED’.

I also want to output any redirect URL to column C

The API I was using accessed a function in IE and an 3rd party reference library which provided a method to imlement a timeout so the code did not hang when URL not found.

So I need something that does not use API calls, that can output the status and any redirect and has a timeout feature.

I tried using MSXML2.XMLHTTP (code below), which works to produce a correct status, but that does not seem to have any timouts and I don’t know if it can return a redirected URL.

Public Function Test_URL_OTHER_METHOD(ByVal url As String) As String

Dim oURL As Object



Set oURL = CreateObject("MSXML2.XMLHTTP")

'Set oURL = CreateObject("WinHttp.WinHttpRequest.5.1")

With oURL

.Open "HEAD", url, False

.Send

If .Status = 200 Then

Test_URL_OTHER_METHOD = "OK"

Else

Test_URL_OTHER_METHOD = "FAILED"

End If



End With



Set oURL = Nothing



End Function

I then tried using WinHttp.WinHttpRequest.5.1 instead, in the same code, which I believe does have timeouts and can return a redirected URL but this always errors out with ‘The server name or address could not be resolved’ error no matter what URL in the list it checks.

Thanks

 

[John_w]

Try this Check_URL function, which uses WinHttp.WinHttpRequest.5.1. It returns a status string for the specified URL.

Public Function Check_URL(ByVal URL As String) As String

    Static httpReq As Object 'WinHttpRequest
    Dim status1 As Long
    Dim statusText1 As String
    Const WinHttpRequestOption_URL = 1
    Const WinHttpRequestOption_SslErrorIgnoreFlags = 4
    Const WinHttpRequestOption_EnableRedirects = 6
        
    If httpReq Is Nothing Then Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    With httpReq
    
        .SetTimeouts 9000, 9000, 9000, 9000 'ResolveTimeout, ConnectTimeout, SendTimeout, ReceiveTimeout
        'See if the URL redirects, but don't follow the redirect (EnableRedirects = False) and ignore all server certificate errors
        .Open "GET", URL, False
        .Option(WinHttpRequestOption_EnableRedirects) = False
        .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300
        On Error GoTo skipError
        .Send
        
        'Set default return string
        status1 = .Status
        statusText1 = .StatusText
        Check_URL = "Status: " & status1 & " " & statusText1 & " - " & .Option(WinHttpRequestOption_URL)
        
        Select Case .Status
            Case Is = 301, 302, 307, 308
                'URL will redirect, so request it again and follow the redirect (EnableRedirects = True)
                .Option(WinHttpRequestOption_EnableRedirects) = True
                .Send
                'Return the redirect status and new URL
                Check_URL = "Status: " & status1 & " " & statusText1 & " - redirected to " & .Status & " " & .StatusText & " " & .Option(WinHttpRequestOption_URL)
        End Select

    End With
    
    Exit Function
    
skipError:
    
    Check_URL = "Error number " & Err.Number & ": " & Replace(Err.Description, vbCrLf, "")
    
End Function

 

[Deutz]

Hi John,

Thanks again for your quality reponses. I have tested your suggested code and so far so good with the status, timouts and redirects. To stop getting the 'Connection with the server failed' error at times, I set the proxy address which seemed to work ...

.SetProxy 2, "sigproxy.prod.atonet.gov.au:8080", ""

The only URL that loaded fine manually and which I could not get to return a 200 status was this link to Amazon, surprisingly ... Amazon.com. Spend less. Smile more.

I get error 503 when I try it via VBA but it loads fine manually from the browser as expected.

Someone suggested setting up a header string.

So I set this below but still get the 503 error code for some reason. Perhaps I need a different header string?

.SetRequestHeader "Content-Type", "text/xml"

Thanks muchly

Deutz

 

[John_w]

I also got error 503 with https://www.amazon.com/.

Fixed it by specifying the User-Agent header, for example:

        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:136.0) Gecko/20100101 Firefox/136.0"

 

[Deutz]

I also got error 503 with https://www.amazon.com/.

Fixed it by specifying the User-Agent header, for example:

        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:136.0) Gecko/20100101 Firefox/136.0"

Thanks John,

that produced a 'method not allowed' error when I placed it before the 'On Error GoTo skipError' but worked when I placed it thusly ...

On Error GoTo skipError
.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:136.0) Gecko/20100101 Firefox/136.0"
.Send

Much appreciated

Rgds
Deutz

 

[Deutz]

Well, that is weird. The first time I ran it with setRequestHeader after the On Error I got status 200. I ran it subsequent times and it reverted back to error 405 Method Not Allowed. Not sure why the inconsistency.

 

[Deutz]

Well, I think the reason that the Amazon URL errors is because i was playing around with the code to see if I could make it any faster and changed GET to HEAD so as to just return the header info. When I changed it back to GET I got status 200. So your code works fine and I learned a lesson not to touch what is not broken. I am guessing I would need some other header string for HEAD.