時給１０３０円の事務員さんのための VBA スクレイピング（ちょっと改善編）

Summary

前回の、時給１０００円の事務員さんのための VBA スクレイピングのつづき

時給１０００円前後の事務員さんがスクレイピングする際の必要なスクレイピングの知識

ご報告

前回書いた時より時給が３０円上がりました

ここにコードをまとめました

ScrapingEx

前回からの改善点

スクレイピングする際のコードが簡潔になりました

安定的にスクレイピングできるようになりました（１レコードで２０ページほど遷移する分を２０００千レコード走らせても安定的にできるようになりました）

サンプルコード

まずはサンプルコード

ロト６の最新の結果を取得する

Public Sub Sample_Loto6()

    ''' スクレイピングＥｘを使えるようにします
    Dim doc As ScrapingEx: Set doc = New ScrapingEx

    ''' ロト６のホームページを開きます
    doc.GotoPage "https://www.mizuhobank.co.jp/retail/takarakuji/loto/loto6/index.html"

    ''' ロト６の最新の結果表のキャリーオーバーの金額のセルが空白でない状態になるまで待ちます
    Dim selector As String: selector = "#mainCol > article > section > section > section > div > div.sp-none > table:nth-child(1) > tbody > tr:nth-child(10) > td > strong"
    doc.Until_TextMatches selector, "[^ \t\n\r\f]"

    ''' ロト６の最新の結果表を配列にします
    Dim tableArr As Variant
    tableArr = ArrTable(doc.CSS("table.typeTK").Index(0).RowTable, True)(1)

    ''' イミディエイトウィンドウにて取得したデータを表示します
    Dim v
    For Each v In tableArr
        Debug.Print Join(v, " ")
    Next v

    ''' ブラウザ（ＩＥ）を片付けます
    doc.Quit
    Set doc = Nothing

End Sub

結果

抽せん日 2019年6月27日
本数字 06 09 12 19 40 42
ボーナス数字 (07)
1等 該当なし 該当なし
2等 10口 7,036,900円
3等 213口 356,700円
4等 12,206口 6,500円
5等 191,383口 1,000円
販売実績額 1,450,251,200円
キャリーオーバー 234,558,536円

改善点

安定的にスクレイピングできるようにするための改善点はおもに下記の５点です

1. エラー時にはＩＥを再起動

エラーが起きた場合の基本的態度です。どうこうするまえに一旦ＩＥを切って再度立ち上げるようにしました。具体的には下記のようなコードにしました

Public Sub foo()

    ''' IEをたちあげる
    Dim doc As ScrapingEx
    On Error GoTo Retry
        Set doc = LaunchIE(timeout_ms)
    On Error GoTo 0

    ''' 処理をおこなう
    Dim err_i As Long, flgPass As Boolean
    On Error GoTo ErrHdl
        Dim v
        For Each v In arr
            If Not flgPass Then
              ''' do somthing
            End If
            flgPass = False
        Next v

    GoTo Ending
Ending:
Exit Sub

''' ----------------------------------------------------
''' Error handling

Retry:
    Resume
ErrHdl:

    ''' 指定回数リトライする
    If err_i < RetryNumber_ Then
        err_i = err_i + 1
        Set doc = Nothing: Set doc = LaunchIE(timeout_ms)
        Resume
    ''' 指定回数以上になった場合は、次の処理項目にうつる
    Else
        err_i = err_i + 1
        Set doc = Nothing: Set doc = LaunchIE(timeout_ms)
        flgPass = True
        err_i = 0
        Resume Next
    End If
End Sub

''' IEの立ち上げ処理
Private Function LaunchIE(Optional ms_timeOut As Long = 30000) As ScrapingEx

    Const url As String = "https://aaa/bbb?"
    UtilScrapingEx.NotPromptClientCertificate InternetZone
    UtilScrapingEx.BeforeScrapingWithIE

    Dim doc As ScrapingEx: Set doc = New ScrapingEx
    doc.TimeOut_milliSeconds = ms_timeOut
    doc.GotoPage url

    Set bar = doc
End Function

2. ブランクページで立ち上げる

ＩＥを立ち上げる時はかならずブランクページの状態にするようにします

下記の手順を踏んでＩＥを立ち上げた時はブランクページで立ち上がるようにします

具体的なコードはここ

Public Sub BeforeScrapingWithIE()

    ''' 1. ＩＥのホームページをブランクページにします
    ''' make homepage blank page
    HomepageBlankOnly

    ''' 2. 前回のセッションの接続を無効にします
    ''' ContinuousBrowsing, isolation, homepage tab
    prepareIE

    ''' 3. すべてのＩＥプロセスを落とします
    ''' clear all ie
    KillAllIE
    DoEvents
    Sleep 1500

    ''' 4. 空白ページでたちあがるようにＩＥをします
    ''' only blank tab page
    BlankTab

End Sub

3. クライアント認証のポップアップを出さないようにする

下記のコードでポップアップを出さないようにします

rf(twitter id @rf0444)さんより多大なアドバイスをいただきました。ありがとうございます！！

''' Don't prompt for client certificate selection when no certificates or only one certificate exists
Public Sub NotPromptClientCertificate(ByVal aZone As ZoneEnum)

    Dim wmi As Object:    Set wmi = CreateObject("Wbemscripting.SWbemLocator")
    Dim wmiSrv As Object: Set wmiSrv = wmi.ConnectServer(".", "root\default")
    Dim oReg As Object:   Set oReg = wmiSrv.Get("StdRegProv")

    Const HKEY_CURRENT_USER As Long = &H80000001

    Dim strKeyPath As String: strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\" & CStr(aZone)
    Const strValueName As String = "1A04"
    Const dwValue As Long = 0  ''' 0 : do not prompt , 3 : prompt
    oReg.SetDWORDValue HKEY_CURRENT_USER, strKeyPath, strValueName, dwValue

End Sub

4.ＩＥのプロセスを分離する

IInternetExplorerManager interfaceを使用することでセキュリティゾーンにまたがるいろいろな問題を回避します

僕の敬愛するくまっちさん（twitter id @kumatti1）さんのコードを使用させていただきました！本当にありがとうございます！！

くまっちさんのコード

5. WithEvent と Until

Event listnerに DocumentComplete event を使います。ホームページが読み込まれるときに発生するイベントでこれを使うことでホームページのHTMLを取得する確率が高まります。下記のように使います。

Private WithEvents gIE  As SHDocVw.InternetExplorer
Private WithEvents gDoc As MSHTML.HTMLDocument

Private Sub gIE_DocumentComplete(ByVal pDisp As Object, url As Variant)
    Sleep 3: Set gDoc = gIE.document
End Sub

また特定要素・文字などが出現するまで待つUntilという関数を作りました。下記のような感じです。下記の関数だと正規表現で文字列を指定してそれが出現するまで待つという関数です。

Public Function Until_TextMatches(ByVal aSelector As String, ByVal strPtrn As String, Optional aTimeOut_ms As Long = 3000) As Boolean

    On Error GoTo Ending

        Until_ElementLocated sm_CSS, aSelector

        Dim regx As Object: Set regx = CreateObject("VBScript.RegExp")
        regx.Pattern = strPtrn: regx.ignorecase = True: regx.Global = True
        Dim i As Long
        Dim start As Double: start = MilliSecondsTimer()

        Do
            On Error Resume Next
                Me.CSS aSelector

            For i = 0 To (Me.Count - 1)
                If regx.test(Me.Index(i).Text) Then
                    Until_TextMatches = True
                    GoTo Ending
                End If
            Next i
            If MilliSecondsTimer() - start > aTimeOut_ms Then GoTo Ending

            DoEvents: Sleep 3

        Loop While Not Until_TextMatches

Ending:
    If Err.Number <> 0 Then Err.clear
    Set regx = Nothing
End Function

ここ２ヶ月で思ったこと

スクレイピングはむずかしい

もうちょっと美味しいお酒を飲みたい（のみたい）

現場からは以上です