Excel Macro получить ссылки переадресации

Question

Возможно ли создать макрос для проверки ссылок перенаправления из ячейки A1: A10?

Например: на ячейке A1 У меня есть ссылка «www.pplware.com», но когда мы открываем ссылку www.pplware.com мы перенаправлять на другой сайт «https://ppware.sapo.pt»

Можно ли написать перенаправление ссылки на ячейки B1: B10? B1: https://ppware.com.sapo.pt

Answer 1

До тех пор, пока перенаправление выполняется с использованием HTTP (301 перемещается постоянно), мы можем использовать WinHttpRequest object для тестирования. Примечание. XMLHTTP невозможен, поскольку это не позволит отключить последующие перенаправления.

Объект WinHttpRequest имеет свойство Option, которое является перечислением WinHttpRequestOption enumeration, где пункт 6. является WinHttpRequestOption_EnableRedirects. Это значение установлено по умолчанию True, поэтому WinHttpRequest сразу же переадресует. Но мы можем установить его False и получить заголовок ответа до того, как будет выполнено перенаправление. Из этого мы можем получить Location:, который является URL, куда направляется переадресация.

Пример:

Public Function testRedirect(oCell As Range) As String 

testRedirect = "not redirected" 

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