IE操作メモ④ - Amazon検索結果一覧取得
Amazon検索結果一覧取得
おはようございます。MacroCatのsiroです。
前回の記事にてAmazonの検索結果一覧を取得するサンプルを載せていたかと思いますが、こちらを少し手直しして、
データ抽出の進捗などわかるようにしたサンプル作りましたのでご紹介いたします。
前回の記事はこちら↓
siroexcelvba.hatenablog.com
ソース
メイン処理
' ' 機能 :検索実行ボタン押下時の処理 ' ' 引数 : ' : ' 返り値 : ' ' 備考 : ' 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