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マクロ

    Microsoft コミュニティに「変更履歴とコメントの表示」オプショ…

  2. アイコン一覧

    Office 2013 アイコン一覧(J)

    ・Office 2013 アイコン一覧 NUM…

  3. アイコン一覧

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

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

  4. Office関連

    ヘッドレス ChromeとSeleniumBasicでWebページ全体のスクリーンショットを撮る方法…

    先日、ヘッドレス ChromeでWebページ全体のスクリーンショットを…

  5. Office関連

    Excel Services JavaScript APIを試してみました(1)

    前回の記事で紹介した「ExcelMashup.com」、このサイトによ…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP