通常、下記のようなリダイレクトされるWebページを開いたとき、
<?php
header('Location: https://www.ka-net.org/blog/');
exit;
HTTPヘッダは下記のようになります。
GET /redirect.php HTTP/1.1 Host: localhost User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64; rv:54.0) Gecko/20100101 Firefox/54.0 Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 Accept-Language: ja,en-US;q=0.7,en;q=0.3 Accept-Encoding: gzip, deflate Connection: keep-alive Upgrade-Insecure-Requests: 1 HTTP/1.1 302 Found Date: Wed, 28 Jun 2017 02:39:48 GMT Server: Apache/2.4.10 (Win32) OpenSSL/1.0.1i PHP/5.5.15 X-Powered-By: PHP/5.5.15 Location: https://www.ka-net.org/blog/ Content-Length: 3 Keep-Alive: timeout=5, max=100 Connection: Keep-Alive Content-Type: text/html
これを見ると、Locationヘッダで移動先のページが指定されていることが分かります。
この値をVBAから取得する場合、WinHttpRequestオブジェクトで普通に処理すると、
Private Sub Sample1()
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "HEAD", "http://localhost/redirect.php", False
.Send
Debug.Print "Status:" & .Status
Debug.Print "----------"
Debug.Print "Headers:"
Debug.Print "----------"
Debug.Print .GetAllResponseHeaders
End With
End Sub
下記のように“リダイレクト先の情報”が取得されてしまい、Locationヘッダの内容を取得することができません。
Status:200 ---------- Headers: ---------- Connection: Keep-Alive Date: Wed, 28 Jun 2017 02:45:24 GMT Keep-Alive: timeout=2, max=100 Content-Type: text/html; charset=UTF-8 Server: Apache X-Powered-By: PHP/5.3.3 Link: <https://www.ka-net.org/blog/?rest_route=/>; rel="https://api.w.org/", <https://wp.me/4UZZr>; rel=shortlink
このような場合には、Optionプロパティでリダイレクト(WinHttpRequestOption_EnableRedirects)を無効にすることにより、Locationヘッダの情報が取得できるようになります。
Private Sub Sample2()
MsgBox GetRedirectUrl("http://localhost/redirect.php"), vbInformation + vbSystemModal
End Sub
Public Function GetRedirectUrl(ByVal url As String) As String
Dim ret As String
Const WinHttpRequestOption_EnableRedirects = 6 'WinHttp.WinHttpRequestOption
On Error Resume Next
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "HEAD", url, False
.Option(WinHttpRequestOption_EnableRedirects) = False 'リダイレクト無効
.Send
Select Case .Status
Case 302: ret = .GetResponseHeader("Location")
End Select
End With
On Error GoTo 0
GetRedirectUrl = ret
End Function

マクロでLocationヘッダの情報を取得する機会もそう多くは無いと思いますが、どなたかの参考になれば幸いです。



















この記事へのコメントはありません。