Scrape Train Service Information from the Web using Excel VBA
はじめに
Excel VBAから、Internet Explorer(IE)を使って、電車の運行情報（平常通り運行しているか、事故・遅延情報はないかということ）を取得するマクロです。
難しい部分を先に言ってしまうと、HTML文書の分析が難しいです。ここでは、比較的カンタンなYahoo! JAPAN 路線情報の運行情報と、東急線運行情報、京王線運行情報や、その他私鉄のサイトから運行情報を取得します。
ご自分の使っている路線のHTML文書の分析が難しい場合、Yahoo! JAPAN 路線情報の運行情報サイトから運行情報を取得することをおススメします。
当然のことながら、運行情報を取得するサイトのHTML文書のアドレスおよび内容構成が変更されれば、このマクロは使えなくなります。
ですので、この記事からやり方を学んで、ご自分の取得したい情報があるサイトへの応用を考えていただければ、と思います。
・動作は無保証です。
・動作確認は、Windows 10 + Excel 2016でおこなっています。
・参照設定は「Microsoft HTML Object Library」「Microsoft Internet Controls」にしてください。
・ファイルはここからダウンロードしてください。
IEで電車の運行情報をウェブから取得するマクロのソースコード
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" _
(ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
Private Const TOKYU_DENTO As String = _
"https://transit.yahoo.co.jp/traininfo/detail/114/0/"
Private Const TOKYU_TOYOKO As String = _
"https://transit.yahoo.co.jp/traininfo/detail/112/0/"
Private Const YAMANOTE_LINE As String = _
"https://transit.yahoo.co.jp/traininfo/detail/21/0/"
Private Const SAIKYO_LINE As String = _
"https://transit.yahoo.co.jp/traininfo/detail/50/0/"
Private Const YOKOHAMA_LINE As String = _
"https://transit.yahoo.co.jp/traininfo/detail/31/0/"
Private Const TOKYU As String = _
"http://www.tokyu.co.jp/i/unten_i.cgi"
Private Const KEIO As String = _
"https://www.keio.co.jp/unkou/unkou_pc.html"
Private Const Hanshin As String = _
"http://rail.hanshin.co.jp/"
Private Const Meitetsu As String = _
"http://top.meitetsu.co.jp/"
Public Sub S_ScrapingTrainInfo_Main()
Dim TargetTime As Date: TargetTime = Now + TimeValue("0:10:00")
Call S_ScrapingTrainInfo_Core
Application.OnTime TargetTime, "S_ScrapingTrainInfo_Main"
End Sub
Public Sub S_ScrapingTrainInfo_Core()
With Worksheets("運行情報")
.Activate
.Range(.Columns(1), .Columns(3)).Delete
End With
Dim IE As InternetExplorer
Set IE = CreateObject("InternetExplorer.Application")
Call S_ScrapingTrainInfo_Yahoo(IE, TOKYU_DENTO)
Call S_ScrapingTrainInfo_Yahoo(IE, TOKYU_TOYOKO)
Call S_ScrapingTrainInfo_Yahoo(IE, YAMANOTE_LINE)
Call S_ScrapingTrainInfo_Yahoo(IE, SAIKYO_LINE)
Call S_ScrapingTrainInfo_Yahoo(IE, YOKOHAMA_LINE)
Call S_ScrapingTrainInfo_Tokyu(IE, TOKYU)
Call S_ScrapingTrainInfo_Keio(IE, KEIO)
Call S_ScrapingTrainInfo_Hanshin(IE, Hanshin)
Call S_ScrapingTrainInfo_Meitetsu(IE, Meitetsu)
IE.Quit: Set IE = Nothing
ThisWorkbook.Save
End Sub
Private Sub S_ScrapingTrainInfo_Yahoo _
(ByVal IE As InternetExplorer, ByVal URL As String)
Dim Doc As HTMLDocument
Set Doc = F_GetHTMLDoc(IE, URL, 10)
With Worksheets("運行情報")
Dim myRow As Long
Select Case URL
Case TOKYU_DENTO
myRow = 1
Case TOKYU_TOYOKO
myRow = 5
Case YAMANOTE_LINE
myRow = 9
Case SAIKYO_LINE
myRow = 13
Case YOKOHAMA_LINE
myRow = 17
End Select
.Cells(myRow, 1).Value = _
Doc.getElementsByClassName("title")(0).innerText
.Cells(myRow + 1, 1).Value = _
Doc.getElementsByClassName("subText")(0).innerText
If Not Doc.getElementsByClassName("normal")(0) Is Nothing Then
.Cells(myRow + 2, 1).Value = _
Doc.getElementsByClassName("normal")(0).innerText
Else
.Cells(myRow + 2, 1).Value = _
Doc.getElementsByClassName("trouble")(0).innerText
End If
.Columns(1).AutoFit
End With
Set Doc = Nothing
End Sub
Private Sub S_ScrapingTrainInfo_Tokyu(ByVal IE As InternetExplorer, _
ByVal URL As String)
Dim Doc As HTMLDocument
Set Doc = F_GetHTMLDoc(IE, URL, 10)
With Worksheets("運行情報")
.Cells(1, 3).Value = Doc.getElementsByTagName("div")(0).innerText
.Cells(2, 3).Value = Doc.getElementsByTagName("div")(1).innerText
.Hyperlinks.Add Anchor:=.Cells(3, 3), _
Address:=URL, _
TextToDisplay:="東急線運行情報サイト"
With .Columns(3)
.ColumnWidth = 50
.AutoFit
End With
.Range(.Rows(1), .Rows(3)).AutoFit
End With
Set Doc = Nothing
End Sub
Private Sub S_ScrapingTrainInfo_Keio(ByVal IE As InternetExplorer, _
ByVal URL As String)
Dim Doc As HTMLDocument
Set Doc = F_GetHTMLDoc(IE, URL, 10)
With Worksheets("運行情報")
.Cells(5, 3).Value = "京王線運行情報"
.Cells(6, 3).Value = _
Doc.getElementsByTagName("p")(1).innerText
.Cells(7, 3).Value = _
Doc.getElementsByClassName("status")(0).innerText
.Hyperlinks.Add Anchor:=.Cells(8, 3), _
Address:=URL, _
TextToDisplay:="京王線運行情報サイト"
With .Columns(3)
.ColumnWidth = 50
.AutoFit
End With
.Range(.Rows(5), .Rows(8)).AutoFit
End With
Set Doc = Nothing
End Sub
Private Sub S_ScrapingTrainInfo_Hanshin _
(ByVal IE As InternetExplorer, ByVal URL As String)
Dim Doc As HTMLDocument
Set Doc = F_GetHTMLDoc(IE, URL, 10)
With Worksheets("運行情報")
.Cells(10, 3).Value = "阪神電車運行情報"
.Cells(11, 3).Value = Format(Now, "m/d h:m") & "現在"
.Cells(12, 3).Value = Doc.getElementsByTagName("li")(27).innerText
.Hyperlinks.Add Anchor:=.Cells(13, 3), _
Address:=URL, _
TextToDisplay:="阪神電車運行情報サイト"
With .Columns(3)
.ColumnWidth = 50
.AutoFit
End With
.Range(.Rows(10), .Rows(13)).AutoFit
End With
Set Doc = Nothing
End Sub
Private Sub S_ScrapingTrainInfo_Meitetsu _
(ByVal IE As InternetExplorer, ByVal URL As String)
Dim Doc As HTMLDocument
Set Doc = F_GetHTMLDoc(IE, URL, 10)
With Worksheets("運行情報")
.Cells(15, 3).Value = "名古屋鉄道運行情報"
.Cells(16, 3).Value = Format(Now, "m/d h:m") & "現在"
.Cells(17, 3).Value = Doc.getElementsByClassName("em")(0).innerText
.Hyperlinks.Add Anchor:=.Cells(18, 3), _
Address:=URL, _
TextToDisplay:="名古屋鉄道運行情報サイト"
With .Columns(3)
.ColumnWidth = 50
.AutoFit
End With
.Range(.Rows(15), .Rows(18)).AutoFit
End With
Set Doc = Nothing
End Sub
Private Function F_GetHTMLDoc(ByVal IE As InternetExplorer, _
ByVal URL As String, _
ByVal mySecond As Long, Optional _
ByVal Flag As Boolean = False) _
As HTMLDocument
IE.Navigate URL
IE.Visible = Flag
Dim myTime As Date: myTime = Now + TimeSerial(0, 0, mySecond)
Do While IE.Busy = True Or IE.ReadyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
If Now > myTime Then
IE.Refresh
myTime = Now + TimeSerial(0, 0, mySecond)
End If
Loop
myTime = Now + TimeSerial(0, 0, mySecond)
Do While IE.Document.ReadyState <> "complete"
DoEvents
Sleep 1
If Now > myTime Then
IE.Refresh
myTime = Now + TimeSerial(0, 0, mySecond)
End If
Loop
Set F_GetHTMLDoc = IE.Document
End Function
電車の運行情報を題材に選んだ理由
わたしは会社勤めをしており、通勤は電車でしています。仕事に電車で行く方も多いのではないでしょうか。また、買い物などの用事などで電車を使うときなどでも、電車がきちんと時刻どおり来るかどうか、遅れたり、事故が起こっていないかどうかが気になる方も多いと思います。
そういう運行情報が気になる方も多いのではないかと思い、題材に選びました。
また、別の意味では、いちいちブラウザを開いて運行情報を確認するのが面倒なので、エクセルファイルを開いておけば自動的に運行情報をスクレイピングしてくれるプログラムがあればラクチンだなと思い、開発に至りました。
Windows API関数の解説
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" _
(ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
Windows API関数とは、Windowsのいろいろな機能やデータをExcel VBAや、VB.NET、C#、Javaなどの外部のプログラムから呼び出して使うための関数です。ここでは、Excel VBAから「Sleep」関数という関数を呼び出して使います。
何か難しそうですが、上記のソースコードを呪文のように書けば、カンタンに「Sleep」関数を使うことができます。
呪文と書きましたが、正確には「APIの宣言」といいます。これはモジュールの中で先頭の部分、プロシージャの前に書く必要があります。
モジュールレベル定数の解説
Private Const TOKYU_DENTO As String = _ "https://transit.yahoo.co.jp/traininfo/detail/114/0/" Private Const TOKYU_TOYOKO As String = _ "https://transit.yahoo.co.jp/traininfo/detail/112/0/" Private Const YAMANOTE_LINE As String = _ "https://transit.yahoo.co.jp/traininfo/detail/21/0/" Private Const SAIKYO_LINE As String = _ "https://transit.yahoo.co.jp/traininfo/detail/50/0/" Private Const YOKOHAMA_LINE As String = _ "https://transit.yahoo.co.jp/traininfo/detail/31/0/" Private Const TOKYU As String = _ "http://www.tokyu.co.jp/i/unten_i.cgi" Private Const KEIO As String = _ "https://www.keio.co.jp/unkou/unkou_pc.html" Private Const Hanshin As String = _ "http://rail.hanshin.co.jp/" Private Const Meitetsu As String = _ "http://top.meitetsu.co.jp/"
モジュールレベル定数は、同じモジュールの中であれば、どのプロシージャからも利用できる定数です。どこからでも使える自由さが第1の利点だとすれば、第2の利点は、メンテナンスが楽になるということです。ここでは呼び出したいURLををモジュールレベル定数に格納して、2つのプロシージャで使っていますが、URLというリテラル値を使うことなく、定数名を使うことでわかりやすくなっています。
ここでは、一定の命名規則を自分で考えて定数名を命名しています。
「Yahoo! JAPAN路線情報」のサイトでは私鉄は「鉄道会社名＋路線名」、JRは「路線名の英語読み」で統一しています。
その他の私鉄のサイトでは「鉄道会社名」で統一しています。ただし、1つのサイトですべての路線の運行情報がとれるサイトだけを対象にしています。
もう1つ注意点を書きますと、私がこれらのサイトにアクセスしたとき、遅れや事故などが発生したのは、「Yahoo! JAPAN路線情報」と「東急電鉄」だけでした。その他の鉄道会社に遅れや事故が発生したときにタグが変更になっている場合は、このマクロはうまく動作しません。
昔と違って、サーバサイドでJavaScriptなどを使って動的にホームページを作成しているので、この点はやむをえないと思っています。
「S_ScrapingTrainInfo_Main」プロシージャの解説
Public Sub S_ScrapingTrainInfo_Main()
Dim TargetTime As Date: TargetTime = Now + TimeValue("0:10:00")
Call S_ScrapingTrainInfo_Core
Application.OnTime TargetTime, "S_ScrapingTrainInfo_Main"
End Sub
このプロシージャがメインのプロシージャです。
このプロシージャをボタンから起動して基本的には一日中ほおっておきます。気が向いたときに、運行情報を確認する、という使い方を想定しています。
この画像の上のボタンの「運行情報取得マクロ自動起動」ボタンを押して、後はほおっておいてください。運行情報を確認したいときは、下の画像の「運行情報」シートを参照してください。
Application.OnTime TargetTime, "S_ScrapingTrainInfo_Main"
Application.OnTimeメソッドの再帰呼び出しを使って、このプログラムの繰り返し起動を可能にしています。ポイントは引数に自分自身のプロシージャを指定することです。
仕組みとしては、まず現在時刻を取得、「S_ScrapingTrainInfo_Core」を実行、そして現在時刻から10分後に自分自身を改めて起動します。
TargetTime = Now + TimeValue("0:10:00")
「TimeValue(“0:10:00”)」は現在時刻の10分後という意味ですが、ここを変更すれば、自由に時間を設定できます。
「15秒後」ならば「TimeValue(“0:00:15”)」、「2時間後」ならば「TimeValue(“2:00:00”)」という要領です。
ひとつ問題点があるとすれば、このプログラムには終わりがない、すなわち、無限ループのプログラムである、ということです
エクセルを起動している限り、本プログラムを含むファイルを閉じたとしても、プログラムが指定時間になるとファイルを開こうとする点です。
しかし、これはカンタンに解決できるものです。ファイルを閉じるだけでなく、エクセル自体をいったん終了すれば無限ループから抜けることができます。
終了用のプログラムをわざわざか書かなくても、エクセルを終了すればよいということです。
「S_ScrapingTrainInfo_Core」プロシージャの解説
Public Sub S_ScrapingTrainInfo_Core()
With Worksheets("運行情報")
.Activate
.Range(.Columns(1), .Columns(3)).Delete
End With
Dim IE As InternetExplorer
Set IE = CreateObject("InternetExplorer.Application")
Call S_ScrapingTrainInfo_Yahoo(IE, TOKYU_DENTO)
Call S_ScrapingTrainInfo_Yahoo(IE, TOKYU_TOYOKO)
Call S_ScrapingTrainInfo_Yahoo(IE, YAMANOTE_LINE)
Call S_ScrapingTrainInfo_Yahoo(IE, SAIKYO_LINE)
Call S_ScrapingTrainInfo_Yahoo(IE, YOKOHAMA_LINE)
Call S_ScrapingTrainInfo_Tokyu(IE, TOKYU)
Call S_ScrapingTrainInfo_Keio(IE, KEIO)
Call S_ScrapingTrainInfo_Hanshin(IE, Hanshin)
Call S_ScrapingTrainInfo_Meitetsu(IE, Meitetsu)
IE.Quit: Set IE = Nothing
ThisWorkbook.Save
End Sub
上に示したボタンの画像で、下のボタンの「運行情報取得マクロ単独起動」ボタンに結び付いているプロシージャです。
私自身はこちらのボタンを愛用していて、ほとんどこちらを使っています。
With Worksheets("運行情報")
.Activate
.Range(.Columns(1), .Columns(3)).Delete
End With
本プログラムの起動ボタンは「プログラム」シートにあるわけですが、本プログラムを起動すると、「運行情報」シートを開きます。
これは体感速度が遅くなるのを防ぐための策です。
というのも、本プログラムはIEを利用しているため、終了までの時間が意外と長くかかるからです。
IEでサイトにアクセスして、データをシートに書き込むという作業を繰り返しているのですが、時間が長くかかるなら、その過程を全部見せてしまえ、という発想です。
.Range(.Columns(1), .Columns(3)).Delete
A列（1番目の列）からC列（3番目の列）までを削除して、前回の結果を消去します。
Dim IE As InternetExplorer
Set IE = CreateObject("InternetExplorer.Application")
「InternetExplorer」型の変数「IE」を宣言し、「CreateObject」関数で「InternetExplorer」型のオブジェクトへの参照を作成して、変数「IE」に代入します。
Call S_ScrapingTrainInfo_Yahoo(IE, TOKYU_DENTO) Call S_ScrapingTrainInfo_Yahoo(IE, TOKYU_TOYOKO) Call S_ScrapingTrainInfo_Yahoo(IE, YAMANOTE_LINE) Call S_ScrapingTrainInfo_Yahoo(IE, SAIKYO_LINE) Call S_ScrapingTrainInfo_Yahoo(IE, YOKOHAMA_LINE) Call S_ScrapingTrainInfo_Tokyu(IE, TOKYU) Call S_ScrapingTrainInfo_Keio(IE, KEIO) Call S_ScrapingTrainInfo_Hanshin(IE, Hanshin) Call S_ScrapingTrainInfo_Meitetsu(IE, Meitetsu)
宣言したばかりの変数「IE」とモジュールレベル定数のURLをサブプロシージャに引数として渡して、具体的な処理はサブプロシージャに任せます。
ここではどのURLが処理されるのかがわかりやすく把握することができます。
IE.Quit: Set IE = Nothing ThisWorkbook.Save
「IE.Quit」でInternetExplorerを終了し、「Set IE = Nothing」でオブジェクト変数「IE」への参照を破棄（解除）しています。
最後にファイルを上書き保存して終了です。
「S_ScrapingTrainInfo_Yahoo」プロシージャの解説
Private Sub S_ScrapingTrainInfo_Yahoo _
(ByVal IE As InternetExplorer, ByVal URL As String)
Dim Doc As HTMLDocument
Set Doc = F_GetHTMLDoc(IE, URL, 10)
With Worksheets("運行情報")
Dim myRow As Long
Select Case URL
Case TOKYU_DENTO
myRow = 1
Case TOKYU_TOYOKO
myRow = 5
Case YAMANOTE_LINE
myRow = 9
Case SAIKYO_LINE
myRow = 13
Case YOKOHAMA_LINE
myRow = 17
End Select
.Cells(myRow, 1).Value = _
Doc.getElementsByClassName("title")(0).innerText
.Cells(myRow + 1, 1).Value = _
Doc.getElementsByClassName("subText")(0).innerText
If Not Doc.getElementsByClassName("normal")(0) Is Nothing Then
.Cells(myRow + 2, 1).Value = _
Doc.getElementsByClassName("normal")(0).innerText
Else
.Cells(myRow + 2, 1).Value = _
Doc.getElementsByClassName("trouble")(0).innerText
End If
.Columns(1).AutoFit
End With
Set Doc = Nothing
End Sub
このプロシージャは、「Yahoo! JAPAN路線情報」のサイトから運行情報をスクレイピングするプログラムです。
値渡しと参照渡し
Private Sub S_ScrapingTrainInfo_Yahoo _ (ByVal IE As InternetExplorer, ByVal URL As String)
「数値型や文字列型の引数の場合は値渡し、オブジェクト型の引数の場合は参照渡し」と思っている方も多いのではないでしょうか。しかし、配列や構造体は参照渡ししかできませんし、実際配列を値渡しで渡そうとすると、エラーがでます。
ですが、本プログラムのようにオブジェクト型の引数でも値渡しはできます。ここでは詳しい説明は省きますが、なぜオブジェクト型の引数でも値渡しができるかを理解するには、メモリアドレスを確認することが絶対に必要です。それは以下のページを読めば、理解の第一歩になるでしょう。
オブジェクトの参照渡し・値渡し:エクセルマクロ・Excel VBAの使い方 – インストラクターのネタ帳
VB のオブジェクト操作はポインタが基本 – sardineの日記
VBAにおける値渡しと参照渡しの違い(ByVal/ByRef)｜蒼月書庫
以上のページを読んで、実際にそれらを使ったプログラムを書くのが一番でしょう。
HTML文書の取得
Dim Doc As HTMLDocument Set Doc = F_GetHTMLDoc(IE, URL, 10)
「HTMLDocument」型の変数「Doc」を宣言して、「F_GetHTMLDoc」ファンクションプロシージャで取得したHTML文書を格納します。
VBAのIEへの応用を説明した普通のサイトで一番てまひまかけて説明していることは、この「F_GetHTMLDoc」ファンクションプロシージャに押し込みました。
書き込みセルの分岐
Dim myRow As Long
Select Case URL
Case TOKYU_DENTO
myRow = 1
Case TOKYU_TOYOKO
myRow = 5
Case YAMANOTE_LINE
myRow = 9
Case SAIKYO_LINE
myRow = 13
Case YOKOHAMA_LINE
myRow = 17
End Select
アクセスするサイトアドレスによって、書き込むセルを変更しています。「myRow」はその基準となる行番号を表します。
「getElementsByClassName」メソッド
.Cells(myRow, 1).Value = _
Doc.getElementsByClassName("title")(0).innerText
「getElementsByClassName」メソッドは、HTML文書の中から「class」属性の要素オブジェクトのHTMLCollectionを返します。
特定の要素を指定するのがふつうなので、そういうときは「添字（そえじ）」を付けます。
1番目の要素なら「(0)」、2番目の要素なら「(1)」と、1少ない数字を指定します。
そして、最終目標の文字列を取得するために「innerText」をつけます。
なぜ、「title」クラスの文字列を取得するかといえば、HTMLソースを見て、
<h1 class="title">東急田園都市線</h1>
というソースを発見したからです。
この、ソースから該当の文字列を発見するのが一番大変です。
HTMLの書き方は千差万別であって、自分の欲しい情報がどのようなタグ付けされているかわからないからです。
.Cells(myRow + 1, 1).Value = _
Doc.getElementsByClassName("subText")(0).innerText
上記と同じく「subText」クラスの文字列を取得します。発見した文字列は、
<span class="subText">7月15日 18時07分更新</span>
です。
次の部分は上記の部分よりもすこし複雑です。
If Not Doc.getElementsByClassName("normal")(0) Is Nothing Then
.Cells(myRow + 2, 1).Value = _
Doc.getElementsByClassName("normal")(0).innerText
Else
.Cells(myRow + 2, 1).Value = _
Doc.getElementsByClassName("trouble")(0).innerText
End If
複雑な理由は、運行情報の内容によって取得する文字列を場合分けして取得する必要があるからです。
<dd class="normal"> <p>現在､事故･遅延に関する情報はありません。</p> </dd>
このHTMLソースを取得したときは、遅れや事故が発生していませんでしたので、「normal」クラスでしたが、遅れや事故が発生すると、このクラスは「trouble」クラスに変化します。
「Doc.getElementsByClassName(“normal”)(0)」はオブジェクトですので、「IS」演算子で「Nothing」と比較し、その全体を「Not」で否定する形で、「normal」クラスが存在する限り、「normal」クラスの文字列を取得し、そうでない場合（「trouble」クラスが存在する場合）は、「trouble」クラスの文字列を取得します。
最後は「A列（１番目の列）」の幅を自動調整し、HTML文書型変数「Doc」に「Nothing」を代入して終了します。
「S_ScrapingTrainInfo_Tokyu」プロシージャの解説
Private Sub S_ScrapingTrainInfo_Tokyu(ByVal IE As InternetExplorer, _
ByVal URL As String)
Dim Doc As HTMLDocument
Set Doc = F_GetHTMLDoc(IE, URL, 10)
With Worksheets("運行情報")
.Cells(1, 3).Value = Doc.getElementsByTagName("div")(0).innerText
.Cells(2, 3).Value = Doc.getElementsByTagName("div")(1).innerText
.Hyperlinks.Add Anchor:=.Cells(3, 3), _
Address:=URL, _
TextToDisplay:="東急線運行情報サイト"
With .Columns(3)
.ColumnWidth = 50
.AutoFit
End With
.Range(.Rows(1), .Rows(3)).AutoFit
End With
Set Doc = Nothing
End Sub
このプロシージャは、「東急線運行情報」のサイトから運行情報をスクレイピングするプログラムです。さまざまな鉄道会社の中でもっともHTML文書のソースがシンプルな会社の1つだと思います。
HTML文書の取得
.Cells(1, 3).Value = Doc.getElementsByTagName("div")(0).innerText
.Cells(2, 3).Value = Doc.getElementsByTagName("div")(1).innerText
ヤフーのサイトと違って、「getElementsByClassName」メソッドは使えません。そのかわり、「getElementsByTagName」メソッドが使えます。一般的には、「getElementsByTagName」メソッドが使えるサイトのほうが多いと思います。HTML文書を作成するのに、タグを使うのは必須ですが、「Class」属性を使うのは必須ではないからです。「getElementsByClassName」メソッドを使って情報を探す場合、そのクラス属性を使うものが少ない（1つや2つ）場合が多い割に、「getElementsByTagName」メソッドを使って情報を探す場合、そのタグを使うものが多い（数十から数百）場合が多いです。
ソースを確認してみましょう。
<div style="background-color: #dcdcdc; text-align: left; font-size: large;"><br> <b>東急線運行情報</b><br><br></div><br> <div style="font-size: large;">2018年7月16日14時14分 現在<br> 東急各線は、平常通り運転しています。</div>
ここでは「div」タグが使われているので、「getElementsByTagName」メソッドが使えるのがわかりました。
Google Chromeでソースを「Ctrl + F」で検索すると、「div」タグの1番目と2番目の要素であることもわかりました。
ここまでわかるとコードが書けますね。
ちなみに、遅れや事故がある場合も取得すべきタグ情報に変化がないことは確認済です。
ハイパーリンクの設定
.Hyperlinks.Add Anchor:=.Cells(3, 3), _
Address:=URL, _
TextToDisplay:="東急線運行情報サイト"
Hyperlinks.Addメソッドの設定は、マクロ記録をして、それを応用して作成すればカンタンだと思います。
「Anchor」パラメータにはRange（セル）オブジェクトかShape（図形）オブジェクトを指定します。ここでは「C3」セルを指定します。
「Address」パラメータにはハイパーリンクのアドレス、ここでは「東急線運行情報」のサイトのアドレスを指定します。
「TextToDisplay」パラメータにはハイパーリンクで表示される文字列、ここでは「東急線運行情報サイト」という文字列を指定します。
最後にセルの高さと幅を自動調整して、変数「Doc」に「Nothing」を代入して終了です。
「S_ScrapingTrainInfo_Keio」プロシージャの解説
Private Sub S_ScrapingTrainInfo_Keio(ByVal IE As InternetExplorer, _
ByVal URL As String)
Dim Doc As HTMLDocument
Set Doc = F_GetHTMLDoc(IE, URL, 10)
With Worksheets("運行情報")
.Cells(5, 3).Value = "京王線運行情報"
.Cells(6, 3).Value = _
Doc.getElementsByTagName("p")(1).innerText
.Cells(7, 3).Value = _
Doc.getElementsByClassName("status")(0).innerText
.Hyperlinks.Add Anchor:=.Cells(8, 3), _
Address:=URL, _
TextToDisplay:="京王線運行情報サイト"
With .Columns(3)
.ColumnWidth = 50
.AutoFit
End With
.Range(.Rows(5), .Rows(8)).AutoFit
End With
Set Doc = Nothing
End Sub
このサイトを選んだのは、比較的に構造がシンプルなサイトの例が東急以外にも欲しかったからです。
説明すべき点も東急のサイトと同じです。ここでは情報の見つけ方についてご説明します。
まずは、「鉄道会社名＋運行情報」でググります。ここでは「京王 運行情報」です。最初に出てくる「運行情報｜京王グループ」をクリックします。開いたホームページを確認すると、「運行情報」とあり、時刻の表記があり、欲しかった運行情報「京王線・井の頭線は平常通り運転しています。」があります。
ここでタグを検索します。ブラウザはInternet Explorerではなく、Microsoft Edgeか、Google Chrome、もしくはメモ帳がいいと思います。
Internet Explorerの「ソースを表示」で出てくる「開発者ツール」は検索がしにくいので、おススメしません。
どうしてもInternet Explorerしか使えない方もいるかと思います。そういう方は、メモ帳を使うのがいいでしょう。
「インターネットオプション」から「プログラム」->「HTMLの編集」と進み、そこで「メモ帳」を選択しましょう。そうすれば「ソースの表示」でメモ帳でソースが表示されます。
それも無理なら、IEの「開発者ツール」で表示されたソースを「メモ帳」にコピペしましょう。すべては検索性向上のためです。
ソースを表示したら、欲しい情報、ここでは「京王線・井の頭線は平常通り運転しています。」を検索します。検索でヒットしたら、周辺のタグを観察します。
<p class="status"><img style="margin-right: 5px;" src="sankaku.gif" width="9" /> 京王線・井の頭線は平常通り運転しています。</p>
ここに「class=”status”」とあるので、「京王線・井の頭線は平常通り運転しています。」という情報は、「status」クラスの情報だということがわかります。さて、「status」クラスの情報だとわかったものの、「status」クラスの情報がこれひとつとは限らないので、こんどは「status」クラスを検索します。
検索ボックスに「status」と入力して検索します。Google Chromeの検索ボックスなら画像のように「status 2/2」と出ますので、「status」クラスの2番目の情報だということがわかります。他のブラウザの場合は、自分で数える必要があります。
続いて、「運行情報」という情報と、現在時刻という情報の確認をします。
「運行情報」という情報を含むタグは次のとおりです。
<h1><img src="images/h1_title.gif" alt="運行情報" width="89" height="22" /></h1>
これを観察すると、「image」タグの「alt」属性に「運行情報」という文字があります。ということは文字列情報として取得することは無理ということです。ですので、プログラム中に「京王線運行情報」という文字列を挿入する文を書きます。
.Cells(5, 3).Value = "京王線運行情報"
現在時刻の情報を含むタグは次のとおりです。
<p style="margin-top: 0;">07月16日 09時15分</p>
現在時刻は「p」タグの中にあります。「getElementsByTagName」メソッドでこれを取得するために検索をします。
プログラムに書くべき命令文は次のようになります。
.Cells(6, 3).Value = _
Doc.getElementsByTagName("p")(1).innerText
「S_ScrapingTrainInfo_Hanshin」プロシージャの解説
Private Sub S_ScrapingTrainInfo_Hanshin _
(ByVal IE As InternetExplorer, ByVal URL As String)
Dim Doc As HTMLDocument
Set Doc = F_GetHTMLDoc(IE, URL, 10)
With Worksheets("運行情報")
.Cells(10, 3).Value = "阪神電車運行情報"
.Cells(11, 3).Value = Format(Now, "m/d h:m") & "現在"
.Cells(12, 3).Value = Doc.getElementsByTagName("li")(27).innerText
.Hyperlinks.Add Anchor:=.Cells(13, 3), _
Address:=URL, _
TextToDisplay:="阪神電車運行情報サイト"
With .Columns(3)
.ColumnWidth = 50
.AutoFit
End With
.Range(.Rows(10), .Rows(13)).AutoFit
End With
Set Doc = Nothing
End Sub
ここでも、このサイトでの情報の見つけ方を説明します。
まず、「運行情報」という情報があるかどうかですが、「現在の運行情報」という文字列が「img」タグの「alt」属性の中にあって、これは取得できない情報です。プログラムに命令文を書きます。
「現在時刻」に関する情報もないので、プログラムに命令文を書きます。
欲しい情報は「現在、30分以上の列車の遅れはございません」ですので、そのタグを観察します。
<li>現在、30分以上の列車の遅れはございません</li>
「li」タグの中に欲しい情報があるので、「li」タグを検索します。
検索すると、28番目の「li」タグの中に欲しい情報がありますので、添字を「(27)」にして命令文を書きます。
「S_ScrapingTrainInfo_Meitetsu」プロシージャの解説
Private Sub S_ScrapingTrainInfo_Meitetsu _
(ByVal IE As InternetExplorer, ByVal URL As String)
Dim Doc As HTMLDocument
Set Doc = F_GetHTMLDoc(IE, URL, 10)
With Worksheets("運行情報")
.Cells(15, 3).Value = "名古屋鉄道運行情報"
.Cells(16, 3).Value = Format(Now, "m/d h:m") & "現在"
.Cells(17, 3).Value = Doc.getElementsByClassName("em")(0).innerText
.Hyperlinks.Add Anchor:=.Cells(18, 3), _
Address:=URL, _
TextToDisplay:="名古屋鉄道運行情報サイト"
With .Columns(3)
.ColumnWidth = 50
.AutoFit
End With
.Range(.Rows(15), .Rows(18)).AutoFit
End With
Set Doc = Nothing
End Sub
このサイトも、「運行情報」という文字列も、「現在時刻」に関する情報もありませんので、上記のサイトと同様の命令文を書きます。
ここで欲しい情報は「30分以上の列車の遅れはございません」という文字列なので、ソースを確認します。
<div class="em"><a href="/em/" target="_blank" rel="noopener"> 30分以上の列車の遅れはございません</a></div>
「em」クラスの中に欲しい情報があるので「em」クラスを検索します。
「em」は2個ありますが、「em」クラスは1個しかないので、添字を「(0)」にして命令文を書きます。
「F_GetHTMLDoc」ファンクションプロシージャの解説
Private Function F_GetHTMLDoc(ByVal IE As InternetExplorer, _
ByVal URL As String, _
ByVal mySecond As Long, Optional _
ByVal Flag As Boolean = False) _
As HTMLDocument
IE.Navigate URL
IE.Visible = Flag
Dim myTime As Date: myTime = Now + TimeSerial(0, 0, mySecond)
Do While IE.Busy = True Or IE.ReadyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
If Now > myTime Then
IE.Refresh
myTime = Now + TimeSerial(0, 0, mySecond)
End If
Loop
myTime = Now + TimeSerial(0, 0, mySecond)
Do While IE.Document.ReadyState <> "complete"
DoEvents
Sleep 1
If Now > myTime Then
IE.Refresh
myTime = Now + TimeSerial(0, 0, mySecond)
End If
Loop
Set F_GetHTMLDoc = IE.Document
End Function
ここでは、ウェブの情報をスクレイピングするときの、いわゆるおまじない、呪文をファンクションプロシージャにして、HTMLDocumentオブジェクトを返します。
なぜファンクションプロシージャにしたかというと、サブプロシージャにするよりも、プロシージャの独立性が高まり、プロシージャを分割しやすくなり、使いまわししやすくなるからです。ここまで触れてきませんでしたが、ここで説明することを理解しておけば、なぜドキュメントの取得まで一気にして、しかも関数で返すのがわかります。
ひとことでいえば、いろんなコトを書くのがめんどくさいから、1つの関数を書いて済ませた、ということです。
ここで参考にしたページをご紹介しておきます。
指定URLを表示するサブルーチン「ieView」の解説
Webページ完全読込待機処理サブルーチン「ieCheck」の解説
これらのページはわかりやすいページですが、そこで扱うのはあくまでもサブプロシージャであり、ファンクションプロシージャではありません。私はHTMLDocumentオブジェクトを返り値として欲しかったので、ファンクションプロシージャにしました。
IE.Navigate URL IE.Visible = Flag Dim myTime As Date: myTime = Now + TimeSerial(0, 0, mySecond)
引数として、InternetExplorer型の変数「IE」、つまりブラウザのオブジェクトをもらっています。親プロシージャである「S_ScrapingTrainInfo_Yahoo」を通じて、その親プロシージャの「S_ScrapingTrainInfo_Core」から「IE」をもらっています。
こうすると、「IE」という変数の宣言、変数へのオブジェクトの代入は1回で済みます。
また、「URL」という変数でサイトのアドレスを引数でもらうのは当然といえます。毎回サイトアドレスのリテラル値を書いていたのでは、このファンクションプロシージャを使いまわすことはできません。
3番目の「mySecond」という変数は、待ち時間の秒数です。何秒待つかということです。ブラウザの起動には時間がかかるし、ホームページを読み込むにも時間がかかります。それを待つ時間を指定する変数です。それをサイトごとに変更できるように引数にしています。このプログラムでは「10秒」にしていますが、ご自身の環境に合わせて待ち時間を変更してください。
「IE.Navigate URL」は「URL」変数に格納されたサイトアドレスのホームページにアクセスするための命令です。アクセスすれば、そのホームページの情報を取得することができます。
「IE.Visible = Flag」は、IEを画面上に表示するための命令です。Flagという引数は、オプション扱いであり、指定しない場合は、「False」が設定されます。この場合、IEが画面上に表示されることはありません。このプログラムの目的は情報の取得なので、IEを表示しても情報の取得スピードが遅くなるだけでメリットはありませんので、IEは非表示のままです。
変数「myTime」には、「現在時刻からmySecondで指定した秒数後の時刻」を格納しています。いわゆる待ち時間を決定しています。
Do While IE.Busy = True Or IE.ReadyState <> READYSTATE_COMPLETE
「IE.Busy」プロパティは、ホームページを読み込み中かどうかを示します。読み込み中は忙しいので「Busy」です。「True」の場合はホームページを読み込み中です。
「IE.ReadyState」プロパティは現在のドキュメントの状態を示します。「READYSTATE_COMPLETE」は完全に読み込みが終了した状態を示す定数です。
全体としては「IEがドキュメントを読み込むのを待っているあいだ」という意味になります。
DoEvents
「DoEvents」関数は時間のかかる処理を実行している場合にWindowsに制御を戻します。制御が戻ったときにWindowsは別の処理をします。
Sleep 1
「Sleep」関数は、1000分の1秒単位で、指定した時間だけ処理を中断します。この場合、1000分の1秒のあいだ、処理を中断します。効果としては「DoEvents」関数と同じく、Windowsに別の処理をさせることができます。
ここに「DoEvents」や「Sleep」を記述する意味は、無限ループを回避する、ということです。スペックの低いパソコンや容量の大きいホームページの場合、いつまでたっても読み込みが終わらない場合があります。そういったときに、エクセルを強制終了するなどして無限ループを回避する方法がとれるようにします。もっとも事前に待ち時間をきちんと設定するのが望ましいといえます。
If Now > myTime Then IE.Refresh myTime = Now + TimeSerial(0, 0, mySecond) End If
これも無限ループを回避する命令文ですが、指定時間（このプログラムの場合は10秒）を過ぎたら、ページの再読み込み（リフレッシュ）をしています。
myTime = Now + TimeSerial(0, 0, mySecond)
Do While IE.Document.ReadyState <> "complete"
DoEvents
Sleep 1
If Now > myTime Then
IE.Refresh
myTime = Now + TimeSerial(0, 0, mySecond)
End If
Loop
上記のループ文とそっくりですが、上記の文が「IE」オブジェクトそのものについてチェックをおこなったのに対して、こちらは読み込まれるHTMLDocumentオブジェクトについてチェックします。HTMLDocumentオブジェクトはHTML文書そのものなので、データの抽出などHTML文書を扱う場合は、より確実に処理できるよう「HTML文書の読み込みが完了しているかどうか」のチェックもおこなったほうが安全です。また、HTMLDocumentオブジェクトのReadyStateプロパティは文字列の「complete」を返します。
Set F_GetHTMLDoc = IE.Document
最後に読み込みの完了したHTMLDocumentオブジェクトを「F_GetHTMLDoc」に代入して終了です。
おわりに
今回は、Excel VBAからIEを利用してウェブ情報をスクレイピングする基本的なやり方を解説しました。題材は電車の運行情報ですが、どんなホームページでも基本的なやり方は同じです。
13のファンクションプロシージャは基本中の基本ですが、面倒な方は13の解説は読まずにただ使うだけでもいいと思います。
ダウンロードできるファイルの標準モジュール「mdl01_Main」には今回解説したソースコードが入力されています。
実は、今回のファイルにはもう1枚標準モジュール「mdl02_Temp」が同梱されていて、それは完成前のソースコードです。
完成前のソースコードは、IntenetExplorer型のオブジェクト変数「IE」とHTMLDocument型のオブジェクト変数「Doc」がモジュールレベル変数になっています。
そして、基本中の基本といった、13のファンクションプロシージャがサブプロシージャとして入力されています。
一般的にパブリック変数やモジュールレベル変数はあまり使わない方がいいとされています。変数のスコープが広すぎて、自分でも混乱するからです。
ただし、この程度の大きさのマクロであれば、完成直前までそのような「広域」変数を用いてプログラムを作り上げ、最終段階で引数を用いたり、ファンクションプロシージャを活用するなどして、「狭い」プロシージャレベル変数に改変するという作り方もありかなと思います。
お時間のある方は「mdl01_Main」モジュールと「mdl02_Temp」モジュールを比較してどのように改変したか考えてみてください。
コメントを残す