時給１０００円の事務員さんのための VBA スクレイピング

## Summary

時給が１０００円前後の事務員さんに必要な`VBA`でのスクレイピングの知識（テーブル編）

### 想定読者さん

事務員さん

### Greeting

こんにちは。時給１０００円の事務派遣バイトを始めた`callmekohei`です。みなさま、いかがお過ごしでしょうか？

福岡というまぁ、ローカル地方都市なのですが、そこでの時給１０００円の事務員さんに求められる業務改善のお仕事内容は例えば、、、

```
ブラウザ上の業務システムでの作業にて
手作業で入力・登録など
１項目あたり３０秒で行なっていたのを
５秒に改善する

また手作業で見受けられたミスはないようにする

たとえば１日５００項目として
１項目あたり２５秒の改善なので
１日あたり約３時間ほどの改善で、
１ヶ月２０日として
年間で７２０時間、時給２０００円（従業員）として
１５０マソの効果金額
```

みたいな感じです。これをだいたい１週間ないし２週間でやれと・・・（地方厳しいぽよ）

その際に必要なテクニックとして`VBA`でのスクレイピングなのですが、まったくの知らない状態から１週間の業務で試行錯誤で身につけたので情報共有（シェア）したいと思います。

### VBAとは？

エクセルなど`Microsoft Office`製品を多用する日本の事務員さんとは相性のいいプログラミング言語（マクロ）です。エクセルに標準で付随してます。使用することは決して楽とは言い切れませんが、習得することで絶大な事務効率の恩恵に授かれます。

### RPAとVBAの関係は？（ここは独り言）

`WinActor`を少しかじった程度なので、なんとも言えないですが、`RPAとVBAの関係`は代替関係でなく補完関係です。そしてここは私感なのですが、もし稟議をとって導入できるもしくは導入検討をしてるのであれば導入した方がいいと思います。その際に速度などで不満がある場合は`VBA`で作り込む方がいいというのが実感です。根拠は`VBA`だけだと事務員さんの負担が大きいからです。一人だけならまだしも複数人の事務員さんでの`VBA`での自動化はほぼ無理だと思います。



### VBAスクレイピングの基礎

いろいろな方がホームページで書かれてるので、そこを参照してみてください。

### 使用するライブラリ

下記２点があると便利なのでおすすめです

スクレイピングする際に便利なライブラリ
[victorze-vba/Scraping](https://github.com/vba-dev/vba-scraping)

VBAで使用する定石な関数が収録されているライブラリ
[vbaidiot/ariawase](https://github.com/vbaidiot/ariawase)

以下、上記２点のライブラリを使用してのコードですが、自作されても構いません

### サンプル１

ヤホーのカレンダーを表示する

![Screen Shot 2019-05-03 at 19.36.30.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/149269/53d43a4a-1e6e-0eb7-cc59-c5dbbeabe2ac.png)


```vb

Private Sub Yahoo_Calendar_Array()

    ''' ============================
    ''' ヤホーのカレンダーを表示する
    ''' ============================
    

    ''' ヤホーを立ち上げる
    Dim url As String: url = "https://www.yahoo.co.jp/"
    Dim doc As Scraping: Set doc = New Scraping
    doc.gotoPage url, True
    
    ''' テーブルを取得する
    Dim selector As String: selector = "#pbcNx > table"
    Dim tables As Scraping: Set tables = ReadyTables(doc, selector, 1)
    
    ''' テーブルを配列にする
    Dim table As Variant: table = ArrTable(tables.index(0).rowTable, True)(1)
    
    '''  各Rowを表示する
    Dim v As Variant
    For Each v In table
        Debug.Print Dump(v)
    Next v
    
    doc.Quit
    
End Sub
```

結果

```vb
Array("日", "月", "火", "水", "木", "金", "土")
Array("26", "27", "28", "29", "30", "31", "1")
Array("2", "3", "4", "5", "6", "7", "8")
Array("9", "10", "11", "12", "13", "14", "15")
Array("16", "17", "18", "19", "20", "21", "22")
Array("23", "24", "25", "26", "27", "28", "29")
Array("30", "1", "2", "3", "4", "5", "6")
```

テーブルを配列に変換する関数

```vb
''' @param table As Object(Of MSHTML.HTMLTable)
''' @return As Variant(Of Array(Of Array (Of Array (Of HTMLTableCell Or String))))
Public Function ArrTable(ByVal table As Object _
    , Optional ByVal asInnerText As Boolean = False) As Variant
    
    Dim arr() As Variant: ReDim arr(0 To table.children.Length - 1)
    
    Dim i As Long
    For i = 0 To UBound(arr)
        arr(i) = ArrTableSection(table.children.Item(i), asInnerText)
    Next i

    ArrTable = arr

End Function

''' @param tblSct As Object(Of MSHTML.HTMLTableSection)
''' @return As Variant(Of Array(Of Array (Of HTMLTableCell Or String)))
Public Function ArrTableSection(ByVal tblSct As Object _
    , Optional ByVal asInnerText As Boolean = False) As Variant

    If typeName(tblSct) = "object HTMLTableSectionElement" Then Err.Raise 13
    Dim n As Long: n = tblSct.children.Length
    Dim arr As Variant: arr = Array(): ReDim arr(0 To n - 1)
    
    Dim i As Long
    For i = 0 To n - 1
        If typeName(tblSct.children.Item(i)) = "HTMLTableRow" Then
            arr(i) = ArrTableSection(tblSct.children.Item(i), asInnerText)
        Else '''HTMLTableCell
            If asInnerText Then
                arr(i) = tblSct.children.Item(i).InnerText
            Else
                Set arr(i) = tblSct.children.Item(i)
            End If
        End If
    Next i
    
    ArrTableSection = arr
    
End Function
```

### サンプル２

ヤホーのカレンダーの 6日 がある行を表示する

業務ロジックを関数に分離する
--> Ariawaseの関数ポインタ（`WinAPI DispCallFuncを使用`）を使用すると便利です！

![Screen Shot 2019-05-03 at 19.43.58.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/149269/b92cfeab-e0b6-00bb-dc6f-ba6d637844ce.png)


```vb
Private Sub Yahoo_Calendar_Within6()

    ''' ===========================================
    ''' ヤホーのカレンダーの 6日 がある行を表示する
    ''' ===========================================

    ''' テーブルを配列に変換する
    Dim url As String: url = "https://www.yahoo.co.jp/"
    Dim doc As Scraping: Set doc = New Scraping
    doc.gotoPage url, True
    Dim selector As String: selector = "#pbcNx > table"
    Dim tables As Scraping: Set tables = ReadyTables(doc, selector, 1)
    Dim table As Variant: table = ArrTable(tables.index(0).rowTable)(1)
    
    ''' 業務ロジック
    ''' 6 という数字があるレコードのみテーブルから抽出する
    Dim v As Variant
    For Each v In ArrRemoveEmpty(ArrMap(init(New Func, vbVariant, AddressOf Within6, vbVariant), table))
        Debug.Print Dump(ArrMap(init(New Func, vbString, AddressOf toInnerText, vbObject), v))
    Next v
    
End Sub

Private Function Within6(ByVal row As Variant) As Variant

    Dim v As Variant
    For Each v In row
        If v.InnerText = "6" Then
            Within6 = row
            GoTo Escape
        End If
    Next v
    
Escape:
End Function
```

結果

```vb
Array("2", "3", "4", "5", "6", "7", "8")
Array("30", "1", "2", "3", "4", "5", "6")
```

### サンプル３

みずほ銀行のホームページから最新のロト６の当選番号テーブルを取得する

ホームページをみたまま取得する（JavaScriptで動的に作成されるHTMLを取得する）

![Screen Shot 2019-05-03 at 19.44.34.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/149269/73883990-a9d3-9d12-7095-4c17e534c406.png)


```vb
Private Sub Sample_Loto6()
    
    ''' ========================================
    ''' ロト６の最新の当選番号テーブルを表示する
    ''' ========================================


    ''' テーブルを配列に変換する
    Dim url As String: url = "https://www.mizuhobank.co.jp/retail/takarakuji/loto/loto6/index.html"
    Dim doc As Scraping: Set doc = New Scraping
    doc.gotoPage url, True
    Dim selector As String: selector = "table.typeTK"
    Dim tables As Scraping: Set tables = ReadyTables(doc, selector, 1, 0, 1)
    Dim tableArr As Variant: tableArr = ArrTable(tables.index(0).rowTable, True)
    
    ''' データを表示する　0 is header, 1 is body , 2 is footer
    ''' header
    Debug.Print Dump(tableArr(0)(0))
    
    ''' body
    Dim v As Variant
    For Each v In tableArr(1)
        Debug.Print Dump(v)
    Next v
    
    doc.Quit
    
End Sub
```

結果

```vb
Array("回別", "第1376回")
Array("抽せん日", "2019年5月2日")
Array("本数字", "02", "05", "22", "31", "32", "43")
Array("ボーナス数字", "(27)", " ")
Array("1等", "該当なし", "該当なし")
Array("2等", "6口", "12,929,700円")
Array("3等", "227口", "369,000円")
Array("4等", "11,845口", "7,400円")
Array("5等", "176,893口", "1,000円")
Array("販売実績額", "1,523,042,600円")
Array("キャリーオーバー", "507,783,386円")
```

テーブルを取りこぼさずに取る関数

```vb
Public Function ReadyTables(ByVal doc As Scraping, ByVal selector As String _
    , Optional ByVal ms_waitTime As Long = 1 _
    , Optional ByVal row As Long = 0 _
    , Optional ByVal col As Long = 0 _
    , Optional ByVal tableIndex As Long = 0 _
    , Optional ByVal tableCount As Long = 1 _
    ) As Scraping
    
    Dim i_error As Long

    On Error GoTo ErrHandle
    
        Dim tables As Scraping, record As Variant
        
        ReadyTablesImpl tables, record, doc, selector, tableIndex, row
        
        ''' Check if a particular element of the array is a empty string.
        Do While record(col) = ""
            Wait ms_waitTime
            DoEvents
            ReadyTablesImpl tables, record, doc, selector, tableIndex, row
        Loop
        
        Do While tables.count < tableCount
            Wait ms_waitTime
            DoEvents
            ReadyTablesImpl tables, record, doc, selector, tableIndex, row
        Loop
    
    On Error GoTo 0
    Set ReadyTables = tables
    GoTo Ending
    
ErrHandle:

    i_error = i_error + 1
    
    If i_error > 500 Then
        MsgBox "Error Raise --- ReadyTables ---"
        Stop
    ElseIf i_error > 100 Then
        ReadyTablesImpl tables, record, doc, selector, tableIndex, row
    End If
    
    Resume
    
Ending:
End Function

Private Function ReadyTablesImpl(ByRef tables As Scraping, ByRef record As Variant, _
    ByVal doc As Scraping, ByVal selector As String, ByVal tableIndex As Long, ByVal row As Long)
    Set tables = doc.css(selector)
    record = ArrTableSection(tables.index(tableIndex).rowTable.children.Item(row), True)
    If IsArray(record(0)) Then record = record(0)
End Function
```

### おまけ

業務改善を求められる事務派遣バイトさんは、オチンギンのわりには求められる要望が高い（ような気がする・・・）のですが、まぁビール飲むためには仕方ないですよね・・・。

この記事が少しでも僕と同じような立場の人にとって役立ってくれると嬉しいです（本当に

### おまけ２

`VBA`のコードを書く際に相談したくなるかもしれません。下記にアクセスすることで運が良ければ回答が得られるかもしれません。活用してみてください。

1.　この記事のコメント欄
2.　`callmekohei`のツイッター @calmekohei
3.　 [Ariawaseの掲示板](https://gitter.im/vbaidiot/ariawase?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)