9
6

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

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

Last updated at Posted at 2019-06-14

初めまして、towerofshibakoenです。2017年12月に登録しましたが、インプットばかりのQiitaライフを送っていました。
そろそろOutputしなくては、と思い、社内でRPAの一環として行っているExcel VBAで書けるようなネタが見つかりましたので書かせていもらいます。なお、概要については「Webデータを活用!WebサイトからデータをExcelに取り込む方法」に譲ります。
#まずはExcel VBAの環境設定!
Excelを開いたときに、そもそも「開発」タブが無ければVBAを立ち上げることができません。"ファイル"→"Excelのオプション"→"リボンのユーザ設定"を開き、右側の「メインタブ」の「開発」を選択します。1.jpg
「開発」→「コードの表示」で"Microsoft Visual Basic for Applications" (VBA)が立ち上がりました。しかし、このままではWebスクレイピングできません。「ツール」→「Microsoft HTML Object Library」および「Microsoft Internet Controls」を選択します。
2.jpg
これで、VBAでWebスクレイピングする準備が整いました。今回は試しに、Googleで Pythonで多用されるコロンについて、"Python colon"で検索することとします。 なお、Excelに"Google"という名のシートを作ることをお忘れなく。

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

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

9
6
3

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
9
6

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?