2013年4月17日

WEBには様々なデータが公開されています。そのデータをExcelやそのほかのアプリに取り込んで利用したいことってありますよね。
VBAからインターネット上のデータにアクセスする方法はちょっとググってみればすぐに分かります。
問題はその次ですよね。どうやつて必要なデータのみを取出すか。
今回はその方法についての一例の紹介です。

これの場合には、なんとなく［class="lowBg06"］をまず探して駅名の始まりを見つけ、次に[ href="/../../station/????????.htm">]のような文字列が見つかれば、そのあとに[駅名]がありそうだ
と、わかりますよね？もちろん他の部分に［class="lowBg06"］がないかとか、[ href="/../../station/????????.htm">]をどうやって特定するか、文字数でできるか？とかいろいろチェックは必要です。

＃なんだかパズルを解くようで楽しくなってきませんか(こんなのが楽しいのは筆者だけですかね)?
それはともかく、
指定されたurlから(上記のソースコード画面のようなイメージの)HTMLコードを取得するサブプロシージャの例をあげておきます。ここで取得したコードをもとに上に書いたような「規則」をコーディングしてデータを取出していきます。

Public Function getHTML(url As String, Optional strBody As _
Variant = Null, Optional incharset As String) As String
    Dim HTTP As Object
    Dim inStrm As Object
    Dim res As String
    Dim pos1 As Long
    Dim pos2 As Long
    Dim http_charset As Variant
    
    
    getHTML = ""
        
    Set HTTP = CreateObject("MSXML2.XMLHTTP")
    HTTP.Open "GET", url, False  
                'false:同期通信　すべての応答が返ってから次へ
    HTTP.Send '実際に要求を送信
    If HTTP.status = 200 Then 
              'エラーページが返ってくるので常に200
        res = HTTP.responseText
        http_charset = "Shift-JIS"
        pos1 = InStr(1, res, "charset=", vbTextCompare)
        If pos1 > 0 Then
            pos2 = InStr(pos1, res, Chr(34), vbTextCompare)
            If pos2 > 0 Then
                http_charset = Replace(Mid(res, pos1, _
                pos2 - pos1), "charset=", "", , , _
                vbTextCompare)
            End If
        End If
        If Not IsNull(res) Then
            Set inStrm = CreateObject("ADODB.Stream")
            With inStrm
                .Open
                .Position = 0
                .Type = 1 'adTypeBinary
                .Write HTTP.responseBody 'streamに書き込む
        
                .Position = 0
                .Type = 2 'adTypeText　for　.readtext
                If incharset <> "" Then
                    '文字コードを指定して呼び出したとき
                    .Charset = incharset '文字コードをセット
                    strBody = .readtext 
                        ' .Charsetエンコードで読み込んだテキスト
                Else
                    .Charset = http_charset 'オリジナルの文字コード
                    getHTML = .readtext 
                        ' .Charsetエンコードで読み込んだテキスト
                End If
                .Close
            End With
            Set inStrm = Nothing
        End If
    End If
    Set HTTP = Nothing
End Function
'getHTMLを呼び出すプロシージャの例
public sub test()
        Dim buf as Variant
        Dim tmp as Variant
        
    buf = getHTML(”http://ekikara.jp/newdata/line/1301241_
                                /down1_1.htm”)
    If buf = "" Then
        Exit sub
    End If
    tmp = Split(buf, vbLf) '1行ずつに分解してtmpへ入れる
    
    '以下「規則」にしたがってtmp()をデコードしていく
    
end sub

HTMLを生成するスクリプトやアプリでは対応できないデータというものが存在します。そんなときには手作業で該当データを修正することもあります。規則の「例外」です。
したがって見つけた規則にも例外が発生します。これを予め知ることは、すべてのデータを見ればその場では対応ができますが、元のデータがバージョンアップなどすると、例外の場所も変わってしま
います。
「見つかったらすぐ対応」するしかないのでしょうかね？