初めまして、towerofshibakoenです。2017年12月に登録しましたが、インプットばかりのQiitaライフを送っていました。
そろそろOutputしなくては、と思い、社内でRPAの一環として行っているExcel VBAで書けるようなネタが見つかりましたので書かせていもらいます。なお、概要については「Webデータを活用!WebサイトからデータをExcelに取り込む方法」に譲ります。
#まずはExcel VBAの環境設定!
Excelを開いたときに、そもそも「開発」タブが無ければVBAを立ち上げることができません。"ファイル"→"Excelのオプション"→"リボンのユーザ設定"を開き、右側の「メインタブ」の「開発」を選択します。
「開発」→「コードの表示」で"Microsoft Visual Basic for Applications" (VBA)が立ち上がりました。しかし、このままではWebスクレイピングできません。「ツール」→「Microsoft HTML Object Library」および「Microsoft Internet Controls」を選択します。
これで、VBAでWebスクレイピングする準備が整いました。今回は試しに、Googleで Pythonで多用されるコロンについて、"Python colon"で検索することとします。 なお、Excelに"Google"という名のシートを作ることをお忘れなく。
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
#実行結果
以下の画像のように出力されます。
罫線は自動では引かれません。
#最後に
これがQiitaにおける最初の投稿になります。書き方などに不備がございましたら、ご指摘いただけたら幸いです。
towerofshibakoenを今後とも宜しくお願い致します。
また、このプログラムを作成するにあたり、ご指導頂きました会社の方には御礼申し上げます。