XMLHTTPオブジェクトを使ってHTMLソースを取得する

前回に引き続きAccessでHTMLを取得する方法をアップします。
今回はIEオブジェクトを使わずにXMLHTTPオブジェクトを使ってHTMLソースを取得する方法について説明したいと思います。

正直に言えば、前回のインターネットエクスプローラーを使った方法では余計な読み込みも多い為、表示するまで時間がかかりますが、XMLHTTPオブジェクトならHTMLソースだけ取得する事が出来るので処理も早くてオススメです。

フォームやYahoo!JAPANロコ路線情報への接続方法などは前回同様ですので説明は省略させていただき、早速サンプルソースを掲載します。

XMLHTTPオブジェクトを使ったサンプルソース

'******************************************
'HTMLを取得する
'******************************************
Private Sub cmd検索_Click()
Dim s出発 As String
Dim s到着 As String
Dim w_URL As String
Dim objHttp As Object
Dim strHtml As Variant
Dim strSearch As Variant
Dim wPosition As Long
Dim wLen As Long
Dim wStartPoint As Long
Dim wEndPoint As Long
Dim i As Integer

'入力漏れがある場合は処理しない。
    If Nz(Me!txb出発, "") = "" Or _
            Nz(Me!txb到着, "") = "" Then Exit Sub

'文字コードをUTF-8に変換
    s出発 = UrlEncodeUtf8(Me!txb出発)
    s到着 = UrlEncodeUtf8(Me!txb到着)

'Yahoo!運賃検索URLを作成する
    w_URL = "http://transit.loco.yahoo.co.jp/search/result?from=" _
                & s出発 & "&to=" & s到着


'XMLHTTPオブジェクトを作成します
    Set objHttp = CreateObject("MSXML2.XMLHTTP")
    
    If objHttp Is Nothing Then
        MsgBox "オブジェクトが作成されませんでした。" _
               , vbOKOnly + vbCritical, "エラー"
        Exit Sub
    End If
    
'HTTPリクエストを作成する
    objHttp.Open "GET", w_URL, False

'HTTPリクエストをサーバに送信する
    objHttp.Send
    
'HTMLソースを取得する
    strHtml = objHttp.responseText
    
'区間を取得する
    '最初の<h2>をセット
    strSearch = "<h2>"
    '文字数を取得
    wLen = Len(strSearch)
    '区間の開始位置を取得
    wStartPoint = InStr(strHtml, strSearch) + wLen
    
    '区間の終わりのタグ<span class="departure">をセット
    strSearch = "<span class=" & """departure""" & ">"
    '区間の終了位置を取得
    wEndPoint = InStr(strHtml, strSearch)
    '区間をテキストボックスにセットする
    Me!txbKukan = Mid(strHtml, wStartPoint, wEndPoint - wStartPoint)
    
'クリアする
    wEndPoint = 1
    Me!txbRoot = Null
    
'検索結果１ページ目（最大３経路）の運賃を取得する
    For i = 1 To 3
    '[安]マークのタグ<span class="route-fare-on">をセット
        strSearch = "<span class=" & """route-fare-on""" & ">"
        wLen = Len(strSearch)
        wStartPoint = InStr(wEndPoint, strHtml, strSearch) + wLen
        
        '[安]マーク料金（route-fare-on）を取得する
        If InStr(wEndPoint, strHtml, strSearch) <> 0 Then
            strSearch = "</span>"
            wEndPoint = InStr(wStartPoint, strHtml, strSearch)
            If Nz(Me!txbRoot, "") <> "" Then
                Me!txbRoot = Me!txbRoot & vbCrLf & _
                    "経路" & i & "：[安]" & _
                    Mid(strHtml, wStartPoint, wEndPoint - wStartPoint)
            Else
                Me!txbRoot = Me!txbRoot & "経路" & i & "：[安]" & _
                    Mid(strHtml, wStartPoint, wEndPoint - wStartPoint)
            End If
        Else
    '[安]マークが付いていない無い料金（route-fare-off）を取得する
            strSearch = "<span class=" & """route-fare-off""" & ">"
            wLen = Len(strSearch)
            wStartPoint = InStr(wEndPoint, strHtml, strSearch) + wLen
        
            If InStr(wEndPoint, strHtml, strSearch) <> 0 Then
                strSearch = "</span>"
                wEndPoint = InStr(wStartPoint, strHtml, strSearch)
                If Nz(Me!txbRoot, "") <> "" Then
                    Me!txbRoot = Me!txbRoot & vbCrLf & _
                        "経路" & i & "：" & _
                        Mid(strHtml, wStartPoint, wEndPoint - wStartPoint)
                Else
                    Me!txbRoot = Me!txbRoot & "経路" & i & "：" & _
                        Mid(strHtml, wStartPoint, wEndPoint - wStartPoint)
                End If
            End If
        End If
    Next i

    Set objIE = Nothing

End Sub

VBAソースの解説

XMLHTTPオブジェクトを作成する
サンプルコード30行目でXMLHTTPオブジェクト（MSXML2.XMLHTTP）を作成します。
サーバに対するHTTPリクエストを作成します。
39行目でopenメソッドを使い、HTMLを取得する為（GET）の検索用URL（引数：w_URL）を同期通信（False）で指定します。
※同期通信（False）にした場合はサーバに対するリクエストからの応答を待ってから次の処理へ進みます。
HTTPリクエストをサーバに送信します。
42行目では39行目で作成したHTTPリクエストをsendメソッドを使い送信しています。
HTMLソースを取得します。
45行目でresponseTextプロパティを使いHTMLソースを取得しています。