2013年4月17日
WEBには様々なデータが公開されています。そのデータをExcelやそのほかのアプリに取り込んで利用したいことってありますよね。
VBAからインターネット上のデータにアクセスする方法はちょっとググってみればすぐに分かります。
問題はその次ですよね。どうやつて必要なデータのみを取出すか。
今回はその方法についての一例の紹介です。
まずは取り込んだデータを眺めることから始めましょう (^_^)
様々なデータがありますが、大量に整然と整理されているデータは、手 |
ここから「駅名」を取出すにはどうすればいいでしょうか?
元のスクリプトなりアプリのソースコードが分かれば、「規則」はすぐ
に分かりますが、それは望むべくもありません。しからばどうするか。
「自分で見つけるしかありません。」
あたりまえですね。すみません m(_
_)m
いきなり取り込みプログラムを書かず、データを眺めてみましょう。
「ソースコードを表示」でこの画面のHTMLを表示させてみます。
これの場合には、なんとなく[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を生成するスクリプトやアプリでは対応できないデータというものが存在します。そんなときには手作業で該当データを修正することもあります。規則の「例外」です。 したがって見つけた規則にも例外が発生します。これを予め知ることは、すべてのデータを見ればその場では対応ができますが、元のデータがバージョンアップなどすると、例外の場所も変わってしま います。 「見つかったらすぐ対応」するしかないのでしょうかね?