Find Redirect URL

[coolkiran]

Hello Everyone

I have a webaddress around 1,000 in column, everything is 302 (Redirecting to another website). IS there any way to find the redirecting website address in Excel. Because I have code,

Function redirect_url(surl As String) As String

Dim myIE As Object
Set myIE = CreateObject("InternetExplorer.Application")
myIE.Navigate surl
Do While myIE.busy
Loop
redirect_url = myIE.Document.URL
myIE.Quit
Set myIE = Nothing

End Function

This is ok for 1-10 urls, if its more than 1000, it will take a day to find web address.

Any suggestion?

 

[Deepak]

Pls check this..

Option Explicit

Public Function Rurl(ByVal url As String)
Dim http As Object
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
    http.Option(WinHttpRequestOption_EnableRedirects) = False
       
    If Not InStr(url, "://") > 0 Then url = "http://" & url
   
    http.Open "GET", url
    http.Send
    Rurl = http.GetResponseHeader("Location")
Set http = Nothing
End Function

 

[coolkiran]

Thanks Deepak, I am getting #Value! error. any reference required?

 

[Deepak]

Try this as didn't encounter any issue so far!!!

Option Explicit

Public Function Rurl(ByVal url As String)
Dim http As New WinHttpRequest
    http.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
    http.Option(WinHttpRequestOption_EnableRedirects) = False
       
    If Not InStr(url, "://") > 0 Then url = "http://" & url
   
    http.Open "GET", url
    http.Send
    Rurl = http.GetResponseHeader("Location")
End Function