VBA – Determine URL Redirect Address

Have you ever needed to check and see if a URL got redirected, and if so what the final resulting URL was?

Well, I did and here’s how I solved the issue!
 

The Solutions

Per the usual, there are a number of approaches that can be employed.  Here are a few I dabbled with.

Option 1 – WinHttp.WinHttpRequest

'---------------------------------------------------------------------------------------
' Procedure : WinHTTP_GetRedirectURL
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Check if a URL gets Redirected and return the final URL
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding  -> None required
'             Early Binding -> Microsoft WinHTTP Services, version X.X
' References:
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sURL      : URL to validate
'
' Usage:
' ~~~~~~
'? WinHTTP_GetRedirectURL("http://office.microsoft.com/en-us/templates/CT101527321033.aspx?av=ZAC")
'   Returns -> https://templates.office.com/?legRedir=true&av=ZAC&CorrelationId=6963d7b0-fbec-4772-ba6e-d273a9e60433
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2013-01-12
' 2         2023-03-20              Updated Error Handling & Header
'---------------------------------------------------------------------------------------
Function WinHTTP_GetRedirectURL(sURL As String) As String
    On Error GoTo Error_Handler

    #Const WinHTTP_EarlyBind = True   'True => Early Binding / False => Late Binding
    #If WinHTTP_EarlyBind = True Then
        Dim oWinHttp          As WinHttp.WinHttpRequest

        Set oWinHttp = New WinHttp.WinHttpRequest
    #Else
        Dim oWinHttp          As Object
        Const WinHttpRequestOption_UserAgentString = 0
        Const WinHttpRequestOption_EnableRedirects = 6

        Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    #End If

    With oWinHttp
        .Option(WinHttpRequestOption_EnableRedirects) = False
        .Option(WinHttpRequestOption_UserAgentString) = "curl"
        .Open "GET", sURL, False
        .Send
        WinHTTP_GetRedirectURL = .getResponseHeader("Location")
    End With

Error_Handler_Exit:
    On Error Resume Next
    Set oWinHttp = Nothing
    Exit Function

Error_Handler:
    If Err.Number = -2147012746 Then
        WinHTTP_GetRedirectURL = sURL
    Else
        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
               "Error Source: WinHTTP_GetRedirectURL" & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occurred!"
    End If
    Resume Error_Handler_Exit
End Function

Option 2 – MSXML2.ServerXMLHTTP

'---------------------------------------------------------------------------------------
' Procedure : MSXML_GetRedirectURL
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Check if a URL gets Redirected and return the final URL
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding  -> None required
'             Early Binding -> Microsoft XML, vX.X
' References: https://learn.microsoft.com/en-us/previous-versions/windows/desktop/ms753798(v=vs.85)
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sURL      : URL to validate
'
' Usage:
' ~~~~~~
'? MSXML_GetRedirectURL("http://office.microsoft.com/en-us/templates/CT101527321033.aspx?av=ZAC")
'   https://templates.office.com/?legRedir=true&av=ZAC&CorrelationId=745f77ac-f509-4c3c-9a63-5d8aca1056f2
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2014-11-07
' 2         2023-03-20              Updated Error Handling & Header
'---------------------------------------------------------------------------------------
Function MSXML_GetRedirectURL(sURL As String) As String
    On Error GoTo Error_Handler

    #Const MSXML_EarlyBind = False
    #If MSXML_EarlyBind = True Then
        Dim oXMLHttp          As MSXML2.ServerXMLHTTP60

        Set oXMLHttp = New MSXML2.ServerXMLHTTP60
    #Else
        Dim oXMLHttp          As Object
        Const SXH_OPTION_URL = -1

        Set oXMLHttp = CreateObject("MSXML2.ServerXMLHTTP")
    #End If

    With oXMLHttp
        
        .Open "HEAD", sURL, False
        .Send
        MSXML_GetRedirectURL = .GetOption(SXH_OPTION_URL)   'final URL even if redirected
    End With

Error_Handler_Exit:
    On Error Resume Next
    Set oXMLHttp = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: MSXML_GetRedirectURL" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

 

Option 3 – Internet Explorer Automation

I just wanted to prove it worked, but I would never recommend using this technique as IE is completely outdated and this approach requires loading all of IE in memory, waiting for the full page to load, … just horrible performance compared to the former 2 solutions.

'---------------------------------------------------------------------------------------
' Procedure : MSXML_GetRedirectURL
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Check if a URL gets Redirected and return the final URL
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding  -> None required
'             Early Binding -> Microsoft Internet Controls
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sURL      : URL to validate
'
' Usage:
' ~~~~~~
'? IE_GetRedirectURL("http://office.microsoft.com/en-us/templates/CT101527321033.aspx?av=ZAC")
'   https://templates.office.com/?legRedir=true&av=ZAC&CorrelationId=745f77ac-f509-4c3c-9a63-5d8aca1056f2
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2023-03-20              
'---------------------------------------------------------------------------------------
Function IE_GetRedirectURL(sURL As String) As String
    On Error GoTo Error_Handler
    #Const IE_EarlyBind = False
    #If IE_EarlyBind = True Then
        Dim oIE As SHDocVw.InternetExplorer

        Set oIE = New SHDocVw.InternetExplorer
    #Else
        Dim oIE As Object

        Set oIE = CreateObject("InternetExplorer.Application")
    #End If

    With oIE
        .Navigate sURL
        .Visible = False    'True/False
        Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
        IE_GetRedirectURL = oIE.LocationURL
    End With

Error_Handler_Exit:
    On Error Resume Next
    oIE.Quit
    Set oIE = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
           "Error Source: IE_GetRedirectURL" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

 

Not So Much Of An Option – MSXML2.XMLHTTP60

This last one just isn’t reliable as it requires the URL to be https and include the www portion …

Just too tempermental for production use, so use one of the other approaches!

Function XMLHTTP_GetRedirectURL(sURL As String) As String
On Error GoTo Error_Handler

    #Const MSXML_EarlyBind = True
    #If MSXML_EarlyBind = True Then
        Dim oXMLHttp As MSXML2.XMLHTTP60

        Set oXMLHttp = New MSXML2.XMLHTTP60
    #Else
        Dim oXMLHttp As Object

        Set oXMLHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    #End If

    With oXMLHttp
        .Open "GET", sURL, False
        .Send
        XMLHTTP_GetRedirectURL = .getResponseHeader("Location")
    End With
    
Error_Handler_Exit:
    On Error Resume Next
    Set oXMLHttp = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: XMLHTTP_GetRedirectURL" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

 

One response on “VBA – Determine URL Redirect Address”

  1. Alexander

    Thank you again for your valuable posting. One of many which I frequently consult to further various projects or my VBA knowledge in general. Sometimes one becomes narrow minded and a different view is then eye-opening.

    Anyways, I have a procedure that retrieves data from various websites. As I run in multiple issues in particular send object error in relation with “MSXML2.ServerXMLHTTP60“, I reverted on those exceptions to “MSXML2.XMLHTTP.6.0” instead.

    Is there a similar command to obtain the final / redirected URL? The line MSXML_GetRedirectURL = .GetOption(SXH_OPTION_URL) is obviously not working. I couldn’t find anything in the dev documentation or internet search though.

    Many thanks for any help / insights!