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. Excel

    PDFファイルにヘッダーとフッターを追加するVBAマクロ

    mougに“マクロで既存のPDFファイルのフッターを操作(追加)したい…

  2. アイコン一覧

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

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

  3. Office関連

    モヤさまのショウ君にいろいろ喋らせるVBAマクロ(1)

    「「VoiceText Web API」(β版) の提供を開始」にある…

  4. アイコン一覧

    Office 2013 アイコン一覧(G)

    ・Office 2013 アイコン一覧 NUM…

  5. Office アドイン

    作業ウィンドウのアプリをWord 2013にも対応させる。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  6. Excel

    組み込み定数を列挙するVBAマクロ

    定数の名前や値を調べたい、そんなときはTypeLib Informat…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP