楽天の検索結果を取得してエクセルに取り込む(スクレイピング)【EXCEL/VBA】

Excel
Person using laptop

VBAで楽天の検索結果を取得して、エクセルの表に取り込む機会があったのでやり方をメモ。
せっかくなので、飼っている猫のエサを検索してエクセルに取り込みたいと思います!

うちのにゃんこは早くも17歳。。最近では年齢に応じた猫エサが販売されてますね。
よくある年齢の区切りは15歳、18歳なので「猫 餌 15歳」の検索結果を取り込んでみます。

取り込むデータの確認

楽天の検索結果

2020年2月10日時点の検索結果は657件。このデータをエクセルにまとめます

エクセルに取り込んだデータ

このような形でデータを取り込みます。ポイントは、商品情報以外にサムネイル画像も取得するところです。

ちなみに、VBAでウェブページを取り込む時の対応ブラウザはIEのみです。
それ以外のブラウザは使用できません。。

取り込む際の注意事項

楽天ページを取り込む際、いくつか注意事項があります。

  • 楽天のリニューアル等でHTML構造に変更があった場合、データをうまく取り込めなくなります。(最終検証:2020年2月)
  • 取り込めるのは楽天の検索結果ページのみです。具体的にはURLが「https://search.rakuten.co.jp/search/mall/~」から始まるページです。
  • サムネイル画像も一緒に取得するので、すべてのデータを取り込むまで時間がかかります。
    私の環境で700件ほどのデータを取得するのに4分もかかりました。。対応策は後程説明します。

完成したVBAコード(全体)

完成したコードはこちらです!長い!

Option Explicit

'URLを指定してIEを取得する
Function UrlIE(UrlTarget As String) As Object
    Dim ie As Object
    Set ie = CreateObject("InternetExplorer.Application")

    ie.Visible = True
    ie.navigate UrlTarget

    Do While ie.Busy Or ie.readyState < 4
        'Debug.Print ie.Busy & ":" & ie.readyState
        DoEvents
    Loop
     Set UrlIE = ie
End Function

'IE読み込み完了
Sub waitNavigation(ie As Object)
    Do While ie.Busy Or (ie.readyState <> 4 And ie.readyState <> 3)
        DoEvents
    Loop
End Sub

'商品一覧を取得
Sub MakeDownloadItems()
    Dim objie As Object
    Set objie = UrlIE("https://search.rakuten.co.jp/search/mall/%E7%8C%AB%E3%80%80%E9%A4%8C+15%E6%AD%B3/")
    Call DownloadItems_Make(objie)
End Sub

Sub DownloadItems_Make(objie As Object)
    
    '一覧取得
    Dim i As Long
    Dim rowNum As Long
    Dim shp As Shape
    Dim elmItem As Object
    Dim divElm As Object
    Dim tagElm As Object
    Dim itemName As String
    Dim itemImage As String
    Dim itemPrice As String
    Dim itemShipping As String
    Dim itemPoint As String
    Dim itemShopName As String
    Dim itemURL As String
    Dim itemScore As String
    Dim itemLegend As String
    
    Dim reg As Object
    Set reg = CreateObject("VBScript.RegExp")
    
    Dim LastNum As Long
    Dim FirstNum As Long
    Dim allItemNum As Long
    Dim confirmBox As Long
    
    LastNum = 0
    FirstNum = 1
    rowNum = 2

    Sheets("商品一覧").Select
    Cells.ClearContents
    
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoLinkedPicture Then
            shp.Delete
        End If
    Next
        
    'タイトル入力
    Cells(1, 1) = "No."
    Cells(1, 2) = "商品画像"
    Cells(1, 3) = "商品名"
    Cells(1, 4) = "価格"
    Cells(1, 5) = "送料"
    Cells(1, 6) = "ポイント"
    Cells(1, 7) = "評価"
    Cells(1, 8) = "評価(件数)"
    Cells(1, 9) = "ショップ名"
    Cells(1, 10) = "URL"

    '幅指定
    Cells(1, 1).ColumnWidth = 5
    Cells(1, 2).ColumnWidth = 10.75
    Cells(1, 3).ColumnWidth = 23.75
    Cells(1, 4).ColumnWidth = 8.38
    Cells(1, 5).ColumnWidth = 11.25
    Cells(1, 6).ColumnWidth = 16.5
    Cells(1, 7).ColumnWidth = 8
    Cells(1, 8).ColumnWidth = 10.5
    Cells(1, 9).ColumnWidth = 26
    Cells(1, 10).ColumnWidth = 10.5

        
    '対象ページの判定
    If objie.document.getElementsByClassName("searchresultitem")(0) Is Nothing Then
        MsgBox "対象ページではありません。処理を中止します"
        Exit Sub
    End If

    '実行するか確認
    With reg
        .Pattern = ".*?\((.+)件\)"       'パターンを指定
        .IgnoreCase = False '大文字と小文字を区別するか(False)、しないか(True)
        .Global = True           '文字列全体を検索するか(True)、しないか(False)
    End With
    
    allItemNum = reg.Replace(objie.document.getElementsByClassName("_medium")(0).innerText, "$1")

    If Int(allItemNum) > 2000 Then
        confirmBox = MsgBox("検索結果は" & Format(allItemNum, "#,##0") & "件です。" & vbNewLine & "処理に時間がかかる場合があります。実行しますか?", vbOKCancel, "※確認※")
    
        If confirmBox = 2 Then 'キャンセルの場合
            MsgBox "処理を中止します。"
            Exit Sub
        End If

    End If
       
Start:
    Cells(rowNum, 1).Select

    With objie.document
        Set elmItem = .getElementsByClassName("searchresultitem")
        
        
        'HTML要素取得
        For Each divElm In elmItem
        
            On Error Resume Next 'エラーが発生しても処理を継続
        
            For Each tagElm In divElm.Children

                
                If tagElm.className Like "*image*" Then
                     itemImage = tagElm.getElementsByClassName("_verticallyaligned")(0).href
                End If
                
                If tagElm.className Like "*title*" Then
                    itemName = tagElm.getElementsByTagName("h2")(0).innerText
                    itemURL = tagElm.getElementsByTagName("a")(0).href
                End If
                
                If tagElm.className Like "*price*" Then
                    itemPrice = tagElm.getElementsByClassName("important")(0).innerHTML
                    itemShipping = tagElm.getElementsByClassName("-shipping")(0).innerHTML
                End If
                
                If tagElm.className Like "*points*" Then
                    itemPoint = tagElm.getElementsByTagName("span")(0).innerText
                End If
                
                If tagElm.className Like "*merchant*" Then
                    itemShopName = tagElm.getElementsByTagName("a")(0).innerText
                End If
                
                If tagElm.className Like "*review*" Then
                    itemScore = tagElm.getElementsByClassName("score")(0).innerText
                    itemLegend = tagElm.getElementsByClassName("legend")(0).innerText
                End If
            Next tagElm
           
            
                Cells(rowNum, 1) = rowNum - 1
                'Cells(rowNum, 2) = itemImage
                Cells(rowNum, 3) = itemName
                Cells(rowNum, 4) = itemPrice
                Cells(rowNum, 5) = itemShipping
                Cells(rowNum, 6) = itemPoint
                Cells(rowNum, 7) = itemScore
                Cells(rowNum, 8) = itemLegend
                Cells(rowNum, 9) = itemShopName
                Cells(rowNum, 10) = itemURL
                
                '価格の「円」を削除
                With reg
                    .Pattern = "(<small>)(.*?)(</small>)"       'パターンを指定
                    .IgnoreCase = False '大文字と小文字を区別するか(False)、しないか(True)
                    .Global = True           '文字列全体を検索するか(True)、しないか(False)
                End With
                Cells(rowNum, 4) = reg.Replace(itemPrice, "")
                
                '画像
                Cells(rowNum, 2).Select
                With ActiveSheet.Shapes.AddPicture( _
                        Filename:=itemImage, _
                        LinkToFile:=True, _
                        SaveWithDocument:=False, _
                        Left:=Selection.Left + 10, _
                        Top:=Selection.Top + 5, _
                        Width:=0, _
                        Height:=0)
                        .ScaleHeight 0.22, msoTrue
                        .ScaleWidth 0.22, msoTrue
                        Cells(rowNum, 2).RowHeight = .Height + 10
                    End With
                rowNum = rowNum + 1 'セルを一行進める
        Next divElm
         
        '複数ページあるかチェック
        If (.getElementsByClassName("dui-pagination")(0)) > 0 Then
            LastNum = .getElementsByClassName("item -last")(0).innerText
        End If
        
        '複数ページある場合
        If LastNum > FirstNum Then
            FirstNum = FirstNum + 1
            .getElementsByClassName("nextPage")(0).Click
             Call waitNavigation(objie)
             GoTo Start
        End If

   End With
       MsgBox "一覧を作成しました"
End Sub

こちらのコードを実行するとIEが起動して、対象ページに遷移します。
尚、楽天の「「猫 餌 15歳」の検索結果を取得するように設定されているので、他の結果を取得する場合、MakeDownloadItemsプロシージャーで宣言されているobjieの値を変更してください!

URLを設定するところ
Set objie = UrlIE(“https://search.rakuten.co.jp/search/mall/%E7%8C%AB%E3%80%80%E9%A4%8C+15%E6%AD%B3/“)
→取り込みたい楽天の検索結果のURLを設定する

取り込んだデータは「商品一覧」という名前のシートに表示させます。プログラムを実行する前に作成しておきます。

楽天の検索結果ページか判定する

今回も長いコードになったので、ポイントだけメモしておきます。
IEでウェブページを開いてオブジェクトとして取得するのは、毎回決まったパターンなので省略します。。

データが取得できたら、まずは楽天の検索結果のページであるかチェックします。

判定は商品情報のHTML要素に設定されているclassの名前で判断します。
商品のHTMLに設定されているclass名は次のようになっています。

商品情報HTML構造

取得したいデータ(商品名や価格など)を内包している親要素「searchresultitem」がなければ、対象外として処理を中止します。

If objie.document.getElementsByClassName("searchresultitem")(0) Is Nothing Then
    MsgBox "対象ページではありません。処理を中止します"
    Exit Sub
End If

検索結果が多い場合の対応

楽天の検索結果ですが、キーワードによっては何万という商品がヒットします。
今回、サムネイル画像も一緒に取得しているので、PCの負荷が大きいです。
実験したところ2,000件以上の検索結果を取得するのはやめておいたほうがよさそうです。

そのため、検索結果が2,000件以上の場合プログラムを実行するか、確認するダイアログを表示させます。

'実行するか確認
With reg
    .Pattern = ".*?\((.+)件\)"       'パターンを指定
    .IgnoreCase = False '大文字と小文字を区別するか(False)、しないか(True)
    .Global = True           '文字列全体を検索するか(True)、しないか(False)
End With

allItemNum = reg.Replace(objie.document.getElementsByClassName("_medium")(0).innerText, "$1")

If Int(allItemNum) > 2000 Then
    confirmBox = MsgBox("検索結果は" & Format(allItemNum, "#,##0") & "件です。" & vbNewLine & "処理に時間がかかる場合があります。実行しますか?", vbOKCancel, "※確認※")

    If confirmBox = 2 Then 'キャンセルの場合
        MsgBox "処理を中止します。"
        Exit Sub
    End If
    
End If

ごにゃごにゃ書いてますが、検索結果に表示された商品の総数を取得して、2,000以上だったらアラートを表示させます。件数が多い場合、キーワードを増やすなどして結果を絞り込むと良いかも。

HTMLの要素を取得する

ここまで準備ができたら、どしどしHTML要素を取得していきます。Forループでぐるぐる回します。

Set elmItem = objie.document.getElementsByClassName("searchresultitem")

'HTML要素取得
For Each divElm In elmItem
    On Error Resume Next 'エラーが発生しても処理を継続

    For Each tagElm In divElm.Children
        If tagElm.className Like "*image*" Then
                itemImage = tagElm.getElementsByClassName("_verticallyaligned")(0).href
        End If
        
        If tagElm.className Like "*title*" Then
            itemName = tagElm.getElementsByTagName("h2")(0).innerText
            itemURL = tagElm.getElementsByTagName("a")(0).href
        End If
        
        If tagElm.className Like "*price*" Then
            itemPrice = tagElm.getElementsByClassName("important")(0).innerHTML
            itemShipping = tagElm.getElementsByClassName("-shipping")(0).innerHTML
        End If
        
        If tagElm.className Like "*points*" Then
            itemPoint = tagElm.getElementsByTagName("span")(0).innerText
        End If
        
        If tagElm.className Like "*merchant*" Then
            itemShopName = tagElm.getElementsByTagName("a")(0).innerText
        End If
        
        If tagElm.className Like "*review*" Then
            itemScore = tagElm.getElementsByClassName("score")(0).innerText
            itemLegend = tagElm.getElementsByClassName("legend")(0).innerText
        End If
    Next tagElm
Next divElm

基本的な流れは、商品名や価格などを内包している「searchresultitem」の要素を取得し、子要素の必要な値を変数に入れていきます。子要素の取得方法は、HTML構造に応じてちょっとずつ違います。
なるべくclass名を基準に取得できるようにしました。

あと、サムネイル画像ですがここではURLを取得します。

エクセルシートに値を反映する

HTML要素を変数に代入したら、値をエクセルシートに反映させればOKです。
コードはこんな感じになりますが、ここは状況に応じて好きな値にしてください。。
ちなみに変数「rowNum」は何行目に表示させるかを表しています。
Forループする時に値を1つ増やしています。

例では2行目を飛ばして値を反映させていますが、これはサムネイル画像をあとで表示させるためです。

Cells(rowNum, 1) = rowNum - 1
Cells(rowNum, 3) = itemName
Cells(rowNum, 4) = itemPrice
Cells(rowNum, 5) = itemShipping
Cells(rowNum, 6) = itemPoint
Cells(rowNum, 7) = itemScore
Cells(rowNum, 8) = itemLegend
Cells(rowNum, 9) = itemShopName
Cells(rowNum, 10) = itemURL

サムネイル画像をエクセルに取り込む

サムネイル画像を取り込むにはShapesコレクションを使います。画像を表示させたいセルを選択して、AddPictureメソッドを実行します。
画像のサイズや表示位置などのパラメーターを設定します。一番大事なファイル名は、先ほど取得したサムネイル画像のURLを設定します。(変数名:itemImage)

Cells(rowNum, 2).Select
With ActiveSheet.Shapes.AddPicture( _
    Filename:=itemImage, _
    LinkToFile:=True, _
    SaveWithDocument:=False, _
    Left:=Selection.Left + 10, _
    Top:=Selection.Top + 5, _
    Width:=0, _
    Height:=0)
    .ScaleHeight 0.22, msoTrue
    .ScaleWidth 0.22, msoTrue
    Cells(rowNum, 2).RowHeight = .Height + 10
End With

複数ページある場合に対応する

これで一通りエクセルに値を反映することができました!
問題は、検索結果が必ずしも1ページに収まらないということです。

複数ページあるかは、検索結果画面の下にあるページャー?っていうんでしょうか。これで判定します。
1ページ内の商品情報をすべて取得して、ページャーがあれば次のページに遷移します。
ページの読み込みが完了したら、GoToラベルでForループの一番最初に戻り、同じ処理を繰り返します。

Start:
    For Each divElm In elmItem
        On Error Resume Next 'エラーが発生しても処理を継続
    
        For Each tagElm In divElm.Children
            'HTML要素を取得するForループ
        Next tagElm
            'Excelシートに反映するForループ
    Next divElm
        
    '複数ページあるかチェック
    If (.getElementsByClassName("dui-pagination")(0)) > 0 Then
        LastNum = .getElementsByClassName("item -last")(0).innerText
    End If
    
    '複数ページある場合
    If LastNum > FirstNum Then
        FirstNum = FirstNum + 1
        .getElementsByClassName("nextPage")(0).Click
            Call waitNavigation(objie)
            GoTo Start
    End If

参考サイト

VBAでHTMLコードを取得する | IE操作の自動化
エクセルVBAでIEのHTMLコードを取得するためのinnerHTML,innerText,outerHTML,outerTextについて解説しています。VBAによるIE(Internet Explorer)制御やデータ取得など基本的なものから実践向けの内容まで幅広くカバーした入門サイト。
outerTextとinnerTextの違いについて | IE操作の自動化
エクセルVBAでIEのHTMLコードを取得するためのouterTextとinnerTextの違いについて解説しています。VBAによるIE(Internet Explorer)制御やデータ取得など基本的なものから実践向けの内容まで幅広くカバーした入門サイト。
エクセルVBA AddPictureメソッドで画像ファイルをエクセルに追加する
ShapesオブジェクトのAddPictureメソッドで、エクセルのシート上に画像を追加する方法をご紹介しています。画像のサイズや位置が決まっている場合、手動で調整するのは手間なもの。エクセルVBAで位置やサイズを指定しておけば、面倒な調整が不要になりますよ。

まとめ

今回もなんとかVBAでウェブのデータを取得できました!データを取得するとことまでは一緒なので色々応用ができそうです。楽天の検索結果は構造が単純だったのでなんとかなりましたが、javascriptで動的に表示させるページはどうなんでしょう。。また機会があったらチャレンジします!

コメント