Macro Excel capture redirects of links [closed]

0

Is it possible to create a macro that copies me the redirects I have in links in cells A1:A100 ?

For example in cell A1 I have www.pplware.com , but when we open this url I'm redirected to another url https://pplware.sapo.pt

What I need is for the macro to write this redirect in the cells B1:B100 , can this be done?

    
asked by anonymous 30.12.2016 / 10:34

1 answer

3

The axel-richter has been able to help me and it works well.

PublicFunctiontestRedirect(oCellAsRange)AsStringtestRedirect="Não Redireciona"

   strURL = oCell.Hyperlinks(1).Address

   WinHttpRequestOption_EnableRedirects = 6

   Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
   oWinHttp.Option(WinHttpRequestOption_EnableRedirects) = False

   oWinHttp.Open "HEAD", strURL, False
   oWinHttp.send ""

   If oWinHttp.Status = 301 Then
    strResponseHeaders = oWinHttp.getAllResponseHeaders()
    For Each strResponseHeader In Split(strResponseHeaders, Chr(10))
     If Left(strResponseHeader, 9) = "Location:" Then
      testRedirect = "redirected to " & strResponseHeader
     End If
    Next
   End If

End Function
    
30.12.2016 / 13:40