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

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

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

取り込むデータの確認
取り込む際の注意事項
完成したVBAコード（全体）
楽天の検索結果ページか判定する
検索結果が多い場合の対応
HTMLの要素を取得する
エクセルシートに値を反映する
1. サムネイル画像をエクセルに取り込む
複数ページある場合に対応する
まとめ

取り込むデータの確認

楽天の検索結果

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

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

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

取り込む際の注意事項

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

楽天のリニューアル等でHTML構造に変更があった場合、データをうまく取り込めなくなります。（最終検証：2020年11月）
取り込めるのは楽天の検索結果ページのみです。具体的にはURLが「https://search.rakuten.co.jp/search/mall/～」から始まるページです。
サムネイル画像も一緒に取得するので、すべてのデータを取り込むまで時間がかかります。

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

完成した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%E3%80%8015%E6%AD%B3/")
    Call DownloadItems_Make(objie)
End Sub

Sub DownloadItems_Make(objie As Object)
    
    '一覧取得
    Dim i As Long
    Dim rowNum As Long
    Dim FirstrowNum As Long
    Dim getItemNum 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 Variant
    
    
    LastNum = 0
    FirstNum = 1
    FirstrowNum = 2
    rowNum = FirstrowNum
    getItemNum = 0

    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")
    
    'メッセージボックス表示
    confirmBox = InputBox("楽天の検索結果は" & Format(allItemNum, "#,##0") & "件でした。" & vbNewLine & "取得する商品の数を1～ " & Format(allItemNum, "#,##0") & "の範囲で入力してください。" & vbNewLine & vbNewLine & "(注)PCの処理が重くなるので、取得数は2,000件以内がおすすめです。")
    
    '実行条件の設定
    If confirmBox = "" Then
        MsgBox "何も入力されませんでした。処理を中止します。"
        Exit Sub
    ElseIf IsNumeric(confirmBox) Then
        If (Int(confirmBox) <= allItemNum) And (Int(confirmBox) >= 1) Then
            getItemNum = confirmBox
            Else
            MsgBox "取得する数は1～ " & Format(allItemNum, "#,##0") & "の範囲で指定してください。処理を中止します。"
            Exit Sub
        End If
    Else
         MsgBox "数字以外の文字が入力されました。処理を中止します。"
         Exit Sub
    End If
    
       
Start:
    Cells(rowNum, 1).Select

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

                
                If tagElm.className Like "*image*" Then
                     itemImage = tagElm.getElementsByClassName("_verticallyaligned")(0).src
                     
                     '画像URLのパラメーターを削除
                     With reg
                        .Pattern = "(\?.*$)"       'パターンを指定
                        .IgnoreCase = False '大文字と小文字を区別するか(False)、しないか(True)
                        .Global = True           '文字列全体を検索するか(True)、しないか(False)
                       End With
                     itemImage = reg.Replace(itemImage, "")
                    
                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("with-help")(0).innerHTML
                    'HTMLタグを削除
                     With reg
                        .Pattern = "<(\s|\S)*?>"
                        .IgnoreCase = False '大文字と小文字を区別するか(False)、しないか(True)
                        .Global = True           '文字列全体を検索するか(True)、しないか(False)
                    End With
                    itemPrice = reg.Replace(itemPrice, "")
                    itemShipping = reg.Replace(itemShipping, "")
                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 = "()(.*?)()"       'パターンを指定
                    .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
                        .LockAspectRatio = True
                        .Width = 55
                        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
            
            ''取得数をオーバーした場合、ページ移動をストップ
             If rowNum <= getItemNum + FirstrowNum Then
                .getElementsByClassName("nextPage")(0).Click
                Call waitNavigation(objie)
                GoTo Start
             End If
             
        End If

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

こちらのコードを実行するとIEが起動して、対象ページに遷移します。

2020.11.6追記
Excelの画面に戻ると、取得数を設定するダイアログが表示されます。数を入力して「OK」をクリックすると処理が実行されます。

尚、コードでは「猫　餌　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名は次のようになっています。

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

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

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

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

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

2020.11.6追記
その対策として、取得数を設定するダイアログが表示されるようにします。入力した数を変数「getItemNum」に代入します。

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

'検索結果トータル数
allItemNum = reg.Replace(objie.document.getElementsByClassName("_medium")(0).innerText, "$1")

'メッセージボックス表示
confirmBox = InputBox("楽天の検索結果は" & Format(allItemNum, "#,##0") & "件でした。" & vbNewLine & "取得する商品の数を1～ " & Format(allItemNum, "#,##0") & "の範囲で入力してください。" & vbNewLine & vbNewLine & "(注)PCの処理が重くなるので、取得数は2,000件以内がおすすめです。")

'実行条件の設定
If confirmBox = "" Then
    MsgBox "何も入力されませんでした。処理を中止します。"
    Exit Sub
ElseIf IsNumeric(confirmBox) Then
    If (Int(confirmBox) <= allItemNum) And (Int(confirmBox) >= 1) Then
        getItemNum = confirmBox
        Else
        MsgBox "取得する数は1～ " & Format(allItemNum, "#,##0") & "の範囲で指定してください。処理を中止します。"
        Exit Sub
    End If
Else
        MsgBox "数字以外の文字が入力されました。処理を中止します。"
        Exit Sub
End If

ごにゃごにゃ書いてますが、検索結果に表示された商品の総数を取得して、その範囲で数を設定するダイアログを表示させます。
平仮名など、数字以外の文字や範囲外の数を設定しようとすると処理は実行されません。
件数が多い場合、キーワードを増やすなどして結果を絞り込むと良いかも。

HTMLの要素を取得する

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

'HTML要素取得
For Each divElm In elmItem
    '行が取得数より大きければ処理を中止
    If rowNum >= getItemNum + FirstrowNum Then
        Exit For
    End If

    On Error Resume Next 'エラーが発生しても処理を継続

    For Each tagElm In divElm.Children

        
        If tagElm.className Like "*image*" Then
                itemImage = tagElm.getElementsByClassName("_verticallyaligned")(0).src
                
                '画像URLのパラメーターを削除
                With reg
                .Pattern = "(\?.*$)"       'パターンを指定
                .IgnoreCase = False '大文字と小文字を区別するか(False)、しないか(True)
                .Global = True           '文字列全体を検索するか(True)、しないか(False)
                End With
                itemImage = reg.Replace(itemImage, "")
            
        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("with-help")(0).innerHTML
            'HTMLタグを削除
                With reg
                .Pattern = "<(\s|\S)*?>"
                .IgnoreCase = False '大文字と小文字を区別するか(False)、しないか(True)
                .Global = True           '文字列全体を検索するか(True)、しないか(False)
            End With
            itemPrice = reg.Replace(itemPrice, "")
            itemShipping = reg.Replace(itemShipping, "")
        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名を基準に取得できるようにしました。

2020.11.6追記
データを入力する行「rowNum」の値が、取得数より大きくなった場合、Forループを終了します。

    '行が取得数より大きければ処理を中止
    If rowNum >= getItemNum + FirstrowNum Then
        Exit For
    End If

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

HTML要素を変数に代入したら、値をエクセルシートに反映させればOKです。
コードはこんな感じになりますが、ここは状況に応じて好きな値にしてください。

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

ちなみに変数「rowNum」は何行目に表示させるかを表しています。
Forループする時に値を１つ増やしています。

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

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

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

2020.10.20追記
取得した画像の大きさがバラバラなので、比率を保ったまま横幅が55ポイントになるように調整します。

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
    .LockAspectRatio = True
    .Width = 55
    Cells(rowNum, 2).RowHeight = .Height + 10
End With

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

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

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

2020.11.6追記
最初に設定した取得数より大きくなったらページの移動をストップします。
行番号を管理している変数「rowNum」の数が、取得数「getItemNum」より大きくなったらストップします。

Start:
    With objie.document
        '複数ページあるかチェック
        If (.getElementsByClassName("dui-pagination")(0)) > 0 Then
            LastNum = .getElementsByClassName("item -last")(0).innerText
        End If

        '複数ページある場合
        If LastNum > FirstNum Then
            FirstNum = FirstNum + 1
            
            '取得数をオーバーした場合、ページ移動をストップ
            If rowNum <= getItemNum + FirstrowNum Then
                .getElementsByClassName("nextPage")(0).Click
                Call waitNavigation(objie)
                GoTo Start
            End If

        End If
    End With

参考サイト

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で動的に表示させるページはどうなんでしょう。。また機会があったらチャレンジします！

ゆうたより:

2020年10月6日 10:45 PM

初めまして、こちらのコードそのままコピー後張り付けて使用してみた結果
インデックスが有効範囲にありませんと出ます、どこを直せばよろしいでしょうか？

返信
- donguri より:
  
  2020年10月8日 2:31 PM
  
  初めまして。「商品一覧」のシートは作成しているでしょうか。
  作成していないようでしたら、次のコードを削除して実行してみてください。
  
  Sheets(“商品一覧”).Select
  
  削除して実行した場合、選択しているシートに上書きされるのでご注意ください。
  よろしくお願いします。
  
  返信
  - ゆうたより:
    
    2020年10月18日 12:11 AM
    
    返信ありがとうございます。
    
    解決いたしました。
    
    動きはするのですが画像が取り込めません…
    
    返信
    - donguri より:
      
      2020年10月20日 11:41 AM
      
      こんにちは。画像ですが、先日までは取り込めていたのですが、できなくなってますね。。
      画像のURLにパラメーターが含まれているとうまくいかないようです。
      この部分を削除するコードを追加したので、お時間があればもう一度お試しください。
      
      返信
としきより:

2020年10月20日 5:06 PM

はじめまして！最初の10商品だけ取得したいのですが、可能でしょうか？
色々試してみたのですがうまくできず、、
教えていただけますと幸いです。

返信
- donguri より:
  
  2020年11月6日 12:09 PM
  
  こんにちは。ご質問ありがとうございます。
  取得する数を設定できるようにコードを変更しました。動作を確認いただけますと幸いです。取得数は書き込むExcelの行数で判定しました。
  よろしくお願いします。
  
  返信