VBA Code to Validate URL and Highlight Cells

CodeNerd · Feb 27th 2017

Hey Guys,

I have a column full of URL's(from cell B2 down). I just need a macro or something to validate each URL and highlight the cell with different color with respective of the results.

If the URL is Valid, I want the cell color to be green.

If the URL redirects, I want the cell color to be yellow.

Finally, If the URL throws a 404 or any other error page, I want the cell color to be grey.

few example URL's are:

Valid One : [TABLE="width: 769"]

[tr]

[TD="class: xl64, width: 769"]https://www.wireless.att.com/b…0-bill-credit-details.jsp ( needs to be green)

Redirected One: [TABLE="width: 769"]

[tr]

[TD="class: xl65, width: 769"]https://www.wireless.att.com/b…ns/200-port-in-credit.jsp (needs to be yellow)

Error Page:[TABLE="width: 769"]

[tr]

[TD="class: xl65, width: 769"]https://www.wireless.att.com/b…/100-bill-credit-July.jsp (needs to be grey)[/TD]

[/tr]

[/TABLE]
[/TD]

[/tr]

[/TABLE]
[/TD]

[/tr]

[/TABLE]

Please help, Thanks in Advance.

**S O** · Feb 27th 2017

Re: VBA Code to Validate URL and Highlight Cells

Hi CodeNerd, welcome to Ozgrid

As a starting point, you could just create a UDF that returns the status code and use that with some conditional formatting in your sheet?

Code

Public Function GetServerResponse(url As String) As Integer


    On Error Resume Next


    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", url
        .Send
        GetServerResponse = .Status
    End With


End Function

Display More

Assuming your URLs are in column A, you would use it in your worksheet like so:

=GetServerResponse(A1)

and just copy down as required.

CodeNerd · Feb 27th 2017

Re: VBA Code to Validate URL and Highlight Cells

Hi SS,
Thanks for your quick response. I am very new to VBA and I was using a code from one of existing sheet I have for this purpose.

The problem with the below code is even though the URL is redirecting the cell will getting highlighted in green. I want the redirected cell to get highlighted in light grey.

Can you able to modify it? Also, I am guessing the line ".Option(WinHttpRequestOption_EnableRedirects) = False" was not supposed to open the redirecting URL but, I believe it is opening the URL by omitting above command.

Code

Function URLExists(url As String) As Integer    'Returns: -1 if invalid URL; 0 if unsure URL; 1 if short URL; 4 if valid URL
    Dim Request As Object
    Dim cl As Long
    Dim te As String
    
    cl = -1
    te = ""
    
    On Error Resume Next
    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    With Request
        .SetTimeouts 0, 60000, 60000, 60000
        'Set AT&T Proxy
        .SetProxy 2, "one.proxy.att.com:8080"
            '.SetRequestHeader "Accept-Encoding", "gzip" 'Force gzip to avoid no-length returns
            '.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:38.0) Gecko/20100101 Firefox/38.0"
        'GET page (can't use HEAD since we want length returned
        .Open "GET", url, False
        'Disable redirects so we capture if one is happening
        .Option(WinHttpRequestOption_EnableRedirects) = False
        .Send
        'if a valid page status is returned
'MsgBox (.Status)
'MsgBox (.Option(WinHttpRequestOption_URL))
'MsgBox (.GetAllResponseHeaders())
        If .Status = 200 Then
            'get response length - if not present, cl will stay -1
            cl = .GetResponseHeader("Content-Length")
            'get transfer encoding used
            te = LCase(.GetResponseHeader("Transfer-Encoding"))
            'if no length returned
            If cl = -1 Then
                'if transfer is chunked
                If te = "chunked" Then
                    'URL is valid
                    URLExists = 4: Exit Function
                'else should be a single block with length but isn't
                Else
                    'URL is funky - check manual
                    URLExists = 0: Exit Function
                End If
            'if page is zero length
            ElseIf cl = 0 Then
                'URL invalid as nothing actually there
                URLExists = -1: Exit Function
            'if the page is too short to be valid
            ElseIf cl < 40 Then
                'manual check
                URLExists = 1: Exit Function
            'else the URL is valid and long enough to be "real"
            Else
                'URL is valid
                URLExists = 4: Exit Function
            End If
        'else a valid page status was not returned (301, 302, 404, etc.)
        Else
           'URL is invalid
            URLExists = -1: Exit Function
        End If
    End With
    
    'void the object
    Set Request = Nothing
    
MsgBox ("shouldn't be here")
ErrorHandle:
    'should never reach here, but failsafe "manual" value
    URLExists = 0
    '-2147012746 - header not found
End Function

Display More

Thanks

**S O** · Feb 27th 2017

Re: VBA Code to Validate URL and Highlight Cells

The problem is that you will only get a redirect response (code 301 for example) if whoever setup the redirect on the server write that into the rule. There is no way of knowing if that has been done without having access to the production server (which I'm assuming you don't have) so if they have set up a straight redirect with no response code then you wouldn't know if there was a redirect - you would get a standard HTTP 200 response.

As far as this line of code is concerned:

Code

.Option(WinHttpRequestOption_EnableRedirects) = False

I suspect that if you put "Option Explicit" at the top of that module you will get a compile error because that variable hasn't been defined. The code you're using looks like it is creating the request via late binding, but "WinHttpRequestOption_EnableRedirects" looks like a constant that can only be used with early binding.

Try changing that line to:

Code

.Option(6) = False

and see if that improves it.

The WinHttpRequestOption enum is as follows:

Code

WinHttpRequestOption_UserAgentString       					'// 0
WinHttpRequestOption_URL									'// 1
WinHttpRequestOption_URLCodePage							'// 2
WinHttpRequestOption_EscapePercentInURL                     '// 3
WinHttpRequestOption_SslErrorIgnoreFlags                    '// 4
WinHttpRequestOption_SelectCertificate                      '// 5
WinHttpRequestOption_EnableRedirects                        '// 6    <~~ this is the one you want.
WinHttpRequestOption_UrlEscapeDisable                       '// 7
WinHttpRequestOption_UrlEscapeDisableQuery                  '// 8
WinHttpRequestOption_SecureProtocols                        '// 9
WinHttpRequestOption_EnableTracing                          '// 10
WinHttpRequestOption_RevertImpersonationOverSsl             '// 11
WinHttpRequestOption_EnableHttpsToHttpRedirects             '// 12
WinHttpRequestOption_EnablePassportAuthentication           '// 13
WinHttpRequestOption_MaxAutomaticRedirects                  '// 14
WinHttpRequestOption_MaxResponseHeaderSize                  '// 15
WinHttpRequestOption_MaxResponseDrainSize                   '// 16
WinHttpRequestOption_EnableHttp1_1                          '// 17
WinHttpRequestOption_EnableCertificateRevocationCheck       '// 18

Display More

CodeNerd · Feb 27th 2017

Re: VBA Code to Validate URL and Highlight Cells

Thanks S O, It works perfectly! Once again thanks for your fast response

:yourock:

**S O** · Feb 27th 2017

Re: VBA Code to Validate URL and Highlight Cells

No worries - glad it got sorted

VBA Code to Validate URL and Highlight Cells

Participate now!

Share