2012年10月24日

インターネット上に公開されているデータを読み込んで自分のデータとして保存したい、または、プログラムに利用したいというとき、どうしてますか?

ブラウザを開いてサイトへいき、目的のページを開いてデータをコピーしてExcelに貼り付けて、と手作業でやってますか？一ページだけとか一回だけならそれでもいいですが、大量に何回もとなるとそうは行きませんよね。

そんな定型作業はコンピュータにやらせましょう。

Excelからも直接そんな仕事ができます。下記はそんなプログラムの一例です。詳しい説明はなしでもわかると思いますので、コメントを読んで見てください。

実際にHTMLを読み込むプロシージャを呼び出すプロシージャ

Private Sub ReadHTML()
    Dim buf As Variant

    buf = getHTML_p("http://ekikara.jp/newdata/state/line/01.htm")
End Sub

■HTMLを読み込んで文字列として返す
Public Function getHTML_p(URL As String, Optional id As String = "", Optional pw As String = "", Optional incharset As String = "") As String 

'url     ログインＩＤ（必要なとき）　パスワード（必要なとき）　文字エンコード（文字化けするとき）

    Dim Http As Object
    Dim inStrm As Object

    getHTML_p = ""

    Set Http = CreateObject("MSXML2.XMLHTTP")

    If id <> "" Then
        Http.Open "GET", URL, False, id, pw
    Else
        Http.Open "GET", URL, False
    End If

  'false:同期通信　すべての応答が返ってから次へ

    実際に要求を送信
    Http.send

    If Http.Status = 200 Then '同期通信の場合はエラーページが返ってくるので常に200

        If incharset = "" Then 'Shift-JISのとき
            getHTML_p = StrConv(Http.responseBody, vbUnicode) 'テキスト　→　Unicode に変換
        Else
        '文字化けする場合は、incharsetを指定してこのプロシージャを呼び出す
        set inStrm = CreateObject("ADODB.Stream")
        With inStrm
             .Open
            .Position = 0
            .Type = 1 'adTypeBinary　←　バイナリのまま
            .Write Http.responseBody 'streamに書き込む

            .Position = 0
            .Type = 2 'adTypeText　テキストで読みだす
            .Charset = incharset '"UTF-8" "EUC-JP"
                    'stream から読み取られるデータを指定文字エンコードに変換

            getHTML_p = .ReadText ' .Charsetエンコードで読み込んだテキスト
            .Close
        End With
        Set inStrm = Nothing
    End If
End If

Set Http = Nothing

End Function