MacroCat@Siro - ExcelVBA・PHP・フリーランス

ExcelVBA、WEBスクレイピング、その他技術に関して書いていきます。

IE操作メモ④ - Amazon検索結果一覧取得

読者になる/フォローする

Amazon検索結果一覧取得

f:id:sirosiro346:20171005220852j:plain

おはようございます。MacroCatのsiroです。
前回の記事にてAmazonの検索結果一覧を取得するサンプルを載せていたかと思いますが、こちらを少し手直しして、
データ抽出の進捗などわかるようにしたサンプル作りましたのでご紹介いたします。

前回の記事はこちら↓
siroexcelvba.hatenablog.com

Amazon検索結果取得ツール動作イメージ

ツール実行後のイメージ
youtu.be

ソース

メイン処理

'
' 機能    :検索実行ボタン押下時の処理
'
' 引数    :
'               :
' 返り値   :
'
' 備考    :
'
Public Sub SearchBtn_Click()
    Dim startCellName As String
    Dim searchCategory As String
    Dim searchKeyword As String
    Dim searchURL As String            '検索するURL
    Dim startPage As Integer
    Dim endPage As Integer
    Dim strMessageCellName As String: strMessageCellName = "B7"
    
    startCellName = "B9" '検索結果を書き込む起点となるセル
    searchCategory = Range("C2").Value
    searchKeyword = Range("C3").Value
    startPage = Range("C4").Value
    endPage = Range("C5").Value
    
    '***********************カテゴリ入力チェック***********************
    'カテゴリが入っていない場合はメッセージ表示
    If IsNull(searchCategory) Or searchCategory = "" Then
        MsgBox "カテゴリを入力してください", vbCritical
        Range("C2").Select
        Exit Sub
    '検索キーワードが入っていない場合はメッセージ表示
    ElseIf IsNull(searchKeyword) Or searchKeyword = "" Then
        MsgBox "検索キーワードを入力してください", vbCritical
        Range("C3").Select
        Exit Sub
    '開始ページが入っていない場合はメッセージ表示
    ElseIf IsNull(startPage) Or startPage = 0 Then
        MsgBox "開始ページを入力してください", vbCritical
        Range("C4").Select
        Exit Sub
    '終了ページが入っていない場合はメッセージ表示
    ElseIf IsNull(endPage) Or endPage = 0 Then
        MsgBox "終了ページを入力してください", vbCritical
        Range("C5").Select
        Exit Sub
    '開始・終了ページの相関チェック
    ElseIf startPage > endPage Then
        MsgBox "終了ページには、開始ページ以上のページ数を入力してください", vbCritical
        Range("C5").Select
        Exit Sub
    End If
    
    searchURL = getDefaultURL(searchCategory, searchKeyword)
    
    '検索結果をクリアする処理
    Call ExcelCommonCls.selectCtrlAClear(startCellName)
    Range(strMessageCellName).Select
    
    '実行中を表示
    Range(strMessageCellName).Value = "実行中です、しばらくお待ちください (" & CStr(startPage) & "/" & CStr(endPage) & ")"
    
    '開始時刻を表示
    Range("F8").Value = Hour(Time) & ":" & Minute(Time) & ":" & Second(Time)
    '************************************検索実行************************************
    Dim rowNo As Long: rowNo = 7
    Dim URLList() As String
    Dim i As Long
    
    'カテゴリ、キーワードを指定したAmazon検索結果をURLリストに格納
    URLList = getSelectCategoryProductsListALL(searchURL, startPage, endPage)

    '************************************結果出力************************************
    For i = 0 To UBound(URLList)
        Cells((i + 9), 2).Value = i + 1 'No
        Cells((i + 9), 3).Value = searchCategory     'カテゴリ
        Cells((i + 9), 4).Value = searchKeyword      '検索キーワード
        ActiveSheet.Hyperlinks.Add Anchor:=Cells((i + 9), 5), Address:=URLList(i)
    Next i
    
    '総件数を表示
    Range(strMessageCellName).Value = "総件数は【" & CStr(UBound(URLList) + 1) & "】件です"
    
    '終了時刻を表示
    Range("F9").Value = Hour(Time) & ":" & Minute(Time) & ":" & Second(Time)
    
    
    MsgBox "処理が完了しました"
    
End Sub


カテゴリごとのもととなるURLを取得するソース

'
' 機能    :カテゴリ、検索キーワードを指定して元となるURLを取得する
'
' 引数    :strCategoryName: カテゴリ名
'               :strKeyword          :  検索キーワード
' 返り値   :
'
' 備考    :
'
Function getDefaultURL(strCategoryName As String, strKeyword As String) As String
    getDefaultURL = ""
    
    Select Case strCategoryName
        Case "Kindle"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Ddigital-text&field-keywords=" & strKeyword
        Case "Amazonビデオ"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dinstant-video&field-keywords=" & strKeyword
        Case "デジタルミュージック"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Ddigital-music&field-keywords=" & strKeyword
        Case "Androidアプリ"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dmobile-apps&field-keywords=" & strKeyword
        Case "本"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dstripbooks&field-keywords=" & strKeyword
        Case "洋書"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Denglish-books&field-keywords=" & strKeyword
        Case "ミュージック"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%Dpopular&field-keywords=" & strKeyword
        Case "クラシック"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dclassical&field-keywords=" & strKeyword
        Case "DVD"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Ddvd&field-keywords=" & strKeyword
        Case "TVゲーム"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dvideogames&field-keywords=" & strKeyword
        Case "PCソフト"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dsoftware&field-keywords=" & strKeyword
        Case "パソコン・周辺機器"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dcomputers&field-keywords=" & strKeyword
        Case "家電&カメラ"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Delectronics&field-keywords=" & strKeyword
        Case "文房具・オフィス用品"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Doffice-products&field-keywords=" & strKeyword
        Case "ホーム&キッチン"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dkitchen&field-keywords=" & strKeyword
        Case "ペット用品"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dpets&field-keywords=" & strKeyword
        Case "ドラッグストア"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dhpc&field-keywords=" & strKeyword
        Case "ビューティー"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dbeauty&field-keywords=" & strKeyword
        Case "ラグジュアリービューティー"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dluxury-beauty&field-keywords=" & strKeyword
        Case "食品・飲料・お酒"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dfood-beverage&field-keywords=" & strKeyword
        Case "ベビー・マタニティ"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dbaby&field-keywords=" & strKeyword
        Case "ファッション"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dfashion&field-keywords=" & strKeyword
        Case "服・ファッション小物"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dapparel&field-keywords=" & strKeyword
        Case "シューズバック&バック"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dshoes&field-keywords=" & strKeyword
        Case "腕時計"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dwatch&field-keywords=" & strKeyword
        Case "おもちゃ"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dtoys&field-keywords=" & strKeyword
        Case "ホビー"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dhobby&field-keywords=" & strKeyword
        Case "ジュエリー"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Djewelry&field-keywords=" & strKeyword
        Case "楽器"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dmi&field-keywords=" & strKeyword
        Case "スポーツ&アウトドア"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dsporting&field-keywords=" & strKeyword
        Case "カー・バイク用品"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dautomotive&field-keywords=" & strKeyword
        Case "DIY・工具"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Ddiy&field-keywords=" & strKeyword
        Case "大型家電"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dappliances&field-keywords=" & strKeyword
        Case "クレジットカード"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dfinancial&field-keywords=" & strKeyword
        Case "ギフト券"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dgift-cards&field-keywords=" & strKeyword
        Case "産業・研究開発用品"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dindustrial&field-keywords=" & strKeyword
        Case "Amazonパントリー"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dpantry&field-keywords=" & strKeyword
        Case "Amazonアウトレット"
            getDefaultURL = "https://www.amazon.co.jp/s/&url=search-alias%3Dwarehouse-deals&field-keywords=" & strKeyword
        Case Else
            getDefaultURL = ""
    End Select
    
    Debug.Print getDefaultURL

End Function


AmazonからURLを取得し、リストに格納するソース

'
' 機能    :URL、開始ページ、終了ページを引数に、製品のリンク一覧を取得する
'
' 引数    :strURL          : カテゴリごとのもととなるURL
'               :intStartPage  :  開始ページ
'               :intEndPage    : 終了ページ
' 返り値   :
'
' 備考    :1 ~ 400ページ(最大表示ページ数)まで遷移してリストに格納
'
Function getSelectCategoryProductsListALL(strURL As String, intStartPage As Integer, intEndPage As Integer) As String()
On Error GoTo getSelectCategoryProductsListALL_Err
    
    Debug.Print "処理開始:" & Time
    
    '******************IEを開く******************
    Dim objIE As InternetExplorer 'IEオブジェクトを準備
    Set objIE = CreateObject("Internetexplorer.Application") '新しいIEオブジェクトを作成してセット
    objIE.Visible = True 'True:IEを表示 , False:IEを非表示
        
    '******************指定したページ数分(1 ~ 400)が最大URLデータ取得処理をループ******************
    Dim strlURL_1() As String 'URL格納用
    ReDim strlURL_1(0)
    Dim pageNo As Integer
    Dim listNo As Integer: listNo = 0 '配列の要素数更新用
    Dim el As IHTMLElement 'IHTMLエレメントオブジェクトを準備
    Dim URL_el As IHTMLElementCollection 'liのHTMLエレメントコレクションを準備
    Dim htmlDoc As HTMLDocument 'HTMLドキュメントオブジェクトを準備
    
    '開始ページ、終了ページ
    For pageNo = intStartPage To intEndPage
    
        '実行中を表示
        Range("B7").Value = "実行中です、しばらくお待ちください (" & CStr(pageNo) & "/" & CStr(intEndPage) & ")"
    
        '検索キーワードを指定したURLを開く
        objIE.navigate strURL & "&page=" & CStr(pageNo)
    
        'ページのデータを取得するために、ページが表示されるまで待つ
        Call SysContentCls.DisplayWait(objIE)
    
        'objIEで読み込まれているHTMLドキュメントをセット
        Set htmlDoc = objIE.document
        
        '商品のli要素を取得
        Set URL_el = htmlDoc.getElementsByClassName("a-link-normal s-access-detail-page  s-color-twister-title-link a-text-normal")
        
        'liの数分処理実行
        For Each el In URL_el
            
            If listNo = 0 Then
                
                strlURL_1(listNo) = el.href
            
            Else
                '要素数を更新
                ReDim Preserve strlURL_1(listNo) 'Preserveは今まで格納した値を残したままにするために記述
                
                strlURL_1(listNo) = el.href
                
            End If
            
            Debug.Print el.href
            
            '要素数を更新
            listNo = listNo + 1
            
        Next el
    
    Next pageNo
    
    'IEを閉じる
    objIE.Quit
    
    '戻り値にURLリストを入れる
    getSelectCategoryProductsListALL = strlURL_1
    
    Debug.Print "全てのリンク取得OK:" & Time
    Exit Function
    
getSelectCategoryProductsListALL_Err:
    MsgBox "エラー発生"

End Function

※objIE.VisibleがTrueの場合はIEが視覚的に見えるようになり、Falseの場合はバックグラウンド処理となるため、
 IEが開いていないように見えます。



検索結果を最初にクリアする処理

'
' 機能    :選択したセルからCtrl + Shift + ↓ & → のデータをクリアする
'
' 引数    :selectCellName:起点となるセル
'
' 返り値   :
'
' 備考    :
'
Sub selectCtrlAClear(selectCellName As String)
    Range(selectCellName).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents
End Sub

IE画面描画後にページが表示されるまで待つ処理

'
' 機能    :IEからページが帰ってくるまで待機
'
' 引数    :InternetExplorer
'
' 返り値   :
'
' 備考    :
'
Sub DisplayWait(objIE As InternetExplorer)
    
    Dim timeOut As Date
    
    '完全にページが表示されるまで待機する
    timeOut = Now + TimeSerial(0, 0, 20)
    
    Do While objIE.Busy = True Or objIE.readyState <> 4
      DoEvents
      Sleep 1
      If Now > timeOut Then
        objIE.Refresh
        timeOut = Now + TimeSerial(0, 0, 20)
      End If
    Loop
    
    timeOut = Now + TimeSerial(0, 0, 20)
    
    Do While objIE.document.readyState <> "complete"
      DoEvents
      Sleep 1
      If Now > timeOut Then
        objIE.Refresh
        timeOut = Now + TimeSerial(0, 0, 20)
      End If
     Loop

End Sub

画面が表示される前に、画面の要素を取得しようとするとエラーになってしまいます。
そのため、上記のようなソースが必要です。


エラー処理やら、細かい部分を省いていますが上記ソースを標準モジュール内に入れていただければ動くと思います。
ご参考になればと思います。

siro