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関連

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

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

  2. アイコン一覧

    Office 365アイコン(imageMso)一覧(T)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  3. Office関連

    Excel 2016でマップグラフを作成する。

    12月6日、Office Insider向けに、Office 2016…

  4. Office関連

    「あのコマンドどこだっけ? for Office 2013」の紹介

    Word MVPの新田さんのブログでも紹介していただいている自作フリー…

  5. Microsoft Teams

    Microsoft Teamsでタブの構築を試してみました。

    下記記事の通り、Office 365に新たなコラボレーションツール「M…

  6. Office関連

    ランダムな文字列を生成するVBAマクロ

    文字数を指定して0-9,A-Zまでのランダムな文字列を生成するマクロで…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP