Excel

Locationヘッダの情報を取得するVBAマクロ

通常、下記のようなリダイレクトされる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ヘッダの情報を取得する機会もそう多くは無いと思いますが、どなたかの参考になれば幸いです。

関連記事

  1. Office関連

    VALUE DOMAINで管理しているドメインをOffice 365で使用する。

    Office 365をセットアップすると設定される初期ドメイン「onm…

  2. アイコン一覧

    Office 2013 アイコン一覧(B)

    ・Office 2013 アイコン一覧 NUM…

  3. アイコン一覧

    Office 2013 アイコン一覧(H)

    ・Office 2013 アイコン一覧 NUM…

  4. Office関連

    メモ帳だけでOutlook用アドインを作ってみる。

    「SharpDevelopでExcel用COMアドインを作成する方法」…

  5. Office アドイン

    [Office用アプリ]マニフェストファイルで多言語対応させる。

    Office用アプリの各種設定を定義するXMLマニフェストファイルです…

コメント

  • コメント (0)

  • トラックバックは利用できません。

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP