m-eye blog

ノンプログラマによるVBAとPythonの学習記録

Excel VBAでIEを操作して電車の運行情報をしゃべらせるマクロその2

f:id:m-eye:20181006130806p:plain

 

はじめに

今回はきのうの続きです。

www.m-eye.net

きのうは、マクロをまず書きはじめるまえに、あたまの中で(紙の上で、あるいはVBEにコメントを残すかたちで)考えるべきことを書きました。

要は、全体を把握しながら細部のプログラミングをすすめましょう、ということです。

じゃないと、「あれ、今なにやってるんだろ?」ということになりかねません。

全体像の把握力というか、イメージする力はプログラミングにも必要ですね。

 

プログミングの全体像と流れをVBEでコメントにしてみる

昨日、おおまかな流れを頭のなかでかんがえたので、それをコメントにしてみました。

Sub Excelに電車の運行情報をしゃべらせるマクロ()
    Call Excelに電車の運行情報をしゃべらせるマクロの中核 _
         となるマクロ

   ' 一定の間隔でこのマクロを呼び出す命令文
End Sub

Sub Excelに電車の運行情報をしゃべらせるマクロの中核 _
    となるマクロ()

    Call 電車の運行情報をスクレイピングするマクロ

    Call Excelにセルの内容をしゃべらせるマクロ
End Sub

Sub 電車の運行情報をスクレイピングするマクロ()
    Call 山手線の運行情報をスクレイピングするマクロ

    Call 東急線の運行情報をスクレイピングするマクロ

   ' ブックを保存する命令文
End Sub

Sub 山手線の運行情報をスクレイピングするマクロ()
   ' HTML文書 = HTML文書を取得する関数

   ' HTML文書を分析する命令文
   ' 必要な要素を取得する命令文
   ' ワークシートに情報を落とし込む命令文
End Sub

Sub 東急線の運行情報をスクレイピングするマクロ()
   ' HTML文書 = HTML文書を取得する関数

   ' HTML文書を分析する命令文
   ' 必要な要素を取得する命令文
   ' ワークシートに情報を落とし込む命令文
End Sub

Function HTML文書を取得する関数 As HTML文書
   ' ExcelでIEを操作する命令文
   ' IEでHTML文書を取得する命令文
End Function

Sub Excelにセルの内容をしゃべらせるマクロ()
   ' セルの内容をしゃべらせる命令文
End Sub

これはあくまでもブログでの説明用です。じっさいに書く書かないはべつにして、あたまの中ではこう考えています。

そして、わたしが自分でコメントを書くときは、サブプロシージャやファンクションプロシージャの名前は最初から英語で、コメントは日本語で書きます。

ここからプログラムを具体化していきます。

 

具体化の手順のまえに全体のソースコードを確認

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function GetInputState Lib _
        "user32" () As LongPtr
#Else
    Private Declare Function GetInputState Lib _
        "user32" () As Long
#End If

#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 YAMANOTE_LINE As String = _
    "https://transit.yahoo.co.jp/traininfo/detail/21/0/"

Private Const TOKYU As String = _
    "http://www.tokyu.co.jp/i/unten_i.cgi"

Public Sub S_SpeakTrainInfo()
    Dim TargetTime As Date

    TargetTime = Now + TimeValue("1:00:00")

    Call S_SpeakTrainInfo_Core

    Application.OnTime TargetTime, "S_SpeakTrainInfo"

End Sub

Public Sub S_SpeakTrainInfo_Core()
    Call S_ScrapeTrainInfo

    Call S_SpeakCellValue

End Sub

Public Sub S_ScrapeTrainInfo()
    With Worksheets("TrainInfo")
        .Activate
        .Range(.Columns(1), .Columns(3)).Delete
    End With

    Dim IE As InternetExplorer
    Set IE = CreateObject("InternetExplorer.Application")

    Call S_ScrapeTrainInfo_Yahoo(IE, YAMANOTE_LINE)
    Call S_ScrapeTrainInfo_Tokyu(IE, TOKYU)

    IE.Quit: Set IE = Nothing

    ThisWorkbook.Save

End Sub

Private Sub S_ScrapeTrainInfo_Yahoo _
    (ByVal IE As InternetExplorer, _
     ByVal URL As String)

    Dim Doc As HTMLDocument
    Set Doc = F_GetHTMLDoc(IE, URL, 10)

    With Worksheets("TrainInfo")
        Dim myRow As Long: myRow = 1

        .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_ScrapeTrainInfo_Tokyu _
    (ByVal IE As InternetExplorer, _
     ByVal URL As String)

    Dim Doc As HTMLDocument
    Set Doc = F_GetHTMLDoc(IE, URL, 10)

    With Worksheets("TrainInfo")
        .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 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

        If GetInputState() = True Then 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"
        If GetInputState() = True Then 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

Public Sub S_SpeakCellValue()
    With Worksheets("TrainInfo")
        .Cells(1, 1).Speak
        .Cells(2, 1).Speak
        .Cells(3, 1).Speak
        .Cells(1, 3).Speak
        .Cells(2, 3).Speak
    
    End With

End Sub

おわりに

きょうはここまで。次回は今回掲載したソースコードと具体化の手順をこまかくみていきましょう。

 

Copyright 2018 m-eye blog All Rights Reserved.