Excel VBAを用いたWebスクレイピングの方法

初めまして、towerofshibakoenです。2017年12月に登録しましたが、インプットばかりのQiitaライフを送っていました。
そろそろOutputしなくては、と思い、社内でRPAの一環として行っているExcel VBAで書けるようなネタが見つかりましたので書かせていもらいます。なお、概要については「<a href="https://qiita.com/Octoparse_Japan/items/a1138bec654c9621281f">Webデータを活用！WebサイトからデータをExcelに取り込む方法</a>」に譲ります。
#まずはExcel VBAの環境設定!
Excelを開いたときに、そもそも「開発」タブが無ければVBAを立ち上げることができません。"ファイル"→"Excelのオプション"→"リボンのユーザ設定"を開き、右側の「メインタブ」の「開発」を選択します。![1.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/231894/6b1eb51b-f8e6-6af9-993a-a422dc189bef.jpeg)
「開発」→「コードの表示」で"Microsoft Visual Basic for Applications" (VBA)が立ち上がりました。しかし、このままではWebスクレイピングできません。「ツール」→「Microsoft HTML Object Library」および「Microsoft Internet Controls」を選択します。
![2.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/231894/482a89c2-d6e6-0c37-8cfb-cf0b568d728d.jpeg)
これで、VBAでWebスクレイピングする準備が整いました。今回は試しに、Googleで Pythonで多用されるコロンについて、"Python colon"で検索することとします。 なお、<b>Excelに"Google"という名のシートを作る</b>ことをお忘れなく。

```vb:SearchingByGoogle.xlsm
Sub Searching_Google()
'ブラウザのオープン
    Dim objIE As InternetExplorer
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = True
    
'IEでGoogleを開く
    objIE.navigate "https://www.google.com"
    Call IEwait(objIE)                          '自作関数: IE待機用
    Call WaitFor(3)                             '自作関数: WaitFor(t):t秒待機

'検索情報の自動入力
    Dim s As String
    s = “Python colon”
    objIE.document.getElementsByName("q")(0).Value = s  '検索BOX. タグ内の"Name"が"q"のものを指す
    objIE.document.getElementsByName("btnK")(0).Click   '"Google検索"をクリック
    Call WaitFor(3)

'検索結果の出力
    Dim shtName As String, sht As Worksheet
    Dim i As Integer, j As Integer, resURL As String, resTitle As String
    Dim a As Object, t As Object, URLs As New Collection, Titles As New Collection
    
'Sheet名
    shtName = "Google"
    Set sht = Worksheets(shtName)
    
'WorksheetのSetting
    j = 0
    sht.Columns(2).ColumnWidth = 25     'B列: URL
    sht.Columns(3).ColumnWidth = 30     'C列: タイトル
    sht.Cells(1, 2).Value = "URL"       'B1
    sht.Cells(1, 3).Value = "TITLE"     'C1
    
'URL取得 (Tag <a>)
    For Each a In objIE.document.getElementsByTagName("a")
        URLs.Add a.href
    Next
    
'10件検索の場合、外部URL以外の情報(ex.広告・キャッシュ等URL)を含むため、58～71行目あたりから3行おきに記述
'設定によるので、"Webソースを表示"→"<a" (閉じるカッコ無し)で検索するのが手っ取り早いです
    For i = 71 To 100 ' i = A To (A + 29)
        If i Mod 3 = 2 Then ' "For i = X to Y"であるなら、この値は、(X mod 3)です
            j = j + 1
            resURL = URLs.Item(i)
            sht.Cells(j + 1, 2).Value = resURL
            sht.Cells(j + 1, 2).WrapText = True '右端折返
        End If
    Next i

'TITLE取得
For Each t In objIE.document.getElementsByTagName("h3")
    Titles.Add t
Next
For i = 1 To 10
    resTitle = Titles.Item(i).innerText
    sht.Cells(i + 1, 3).Value = resTitle
    sht.Cells(i + 1, 3).WrapText = True
Next i

'IEクローズ
    objIE.Quit
    Set objIE = Nothing
End Sub

'IE待機用関数
Sub IEWait(ByRef objIE As Object)
    Do While objIE.Busy Or objIE.readyState <> 4
        DoEvents
    Loop
End Sub

't[sec]待機させる関数
Sub WaitFor(ByVal second As Integer)
    Dim futuretime As Date
    futuretime = DateAdd("s", second, Now)
    While Now < futuretime
        DoEvents
    Wend
End Sub
```

#実行結果
以下の画像のように出力されます。
罫線は自動では引かれません。

![3.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/231894/4a361aee-46a1-2448-6c5e-b58a97ef0717.jpeg)

#最後に
これがQiitaにおける最初の投稿になります。書き方などに不備がございましたら、ご指摘いただけたら幸いです。
towerofshibakoenを今後とも宜しくお願い致します。
また、このプログラムを作成するにあたり、ご指導頂きました会社の方には御礼申し上げます。