Office関連

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

Windows Insider Meetup in Japan 2 東京に参加しました。前のページ

2017年6月の人気記事次のページ

関連記事

  1. Office関連

    VBA Word 97/98ハンドブックを購入しました。

    ブックオフにあった「VBA Word 97/98ハンドブッ…

  2. Office関連

    「EXCEL VBA 業務自動化 仕事の効率を劇的に上げるノウハウ」レビュー

    ※ 下記レビューはあくまでも個人的な感想です。2015年4…

  3. Office関連

    Google Docs APIを使ってGoogle ドキュメントを操作するVBAマクロ

    前回の記事で新しく追加されたGoogle Docs APIを紹介しまし…

  4. Office関連

    セルの行数をカウントするWordマクロ

    「ソースコードを番号行付きのテーブルに変換するWordマクロ」を実行し…

  5. Office関連

    オデッセイ コミュニケーションズ主催のExcel VBA入門セミナーに参加しました。

    今月19日に開催されたオデッセイ コミュニケーションズさん主催の「Ex…

  6. Office関連

    Google翻訳の言語自動検出機能を追う

    「Google TTSで文字列を読み上げるマクロ」でGoogle翻訳の…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP