###前提・実現したいこと
http://n73.jugem.jp/?eid=50
↑を参考にVBAで楽天市場の検索結果から商品一覧情報を一括取得し、エクセルのシートに記述。
###発生している問題・エラーメッセージ
次ページへの自動遷移まではできているが、その後DOMからデータの取得ができていないのか下記コードが動いていません。
'// データ行のみ対象 If b.getAttribute("class") = "rsrSResultSect" Then '// エクセルに転記する ActiveSheet.Range("A" & row).Select ActiveSheet.Range("A" & row).Value2 = row - 1 'No ActiveSheet.Range("C" & row).Value2 = b.getElementsByTagName("DIV")(2).Children(0).href '詳細情報ページ ActiveSheet.Range("D" & row).Value2 = b.getElementsByTagName("DIV")(2).Children(0).innerText '商品名 ActiveSheet.Range("E" & row).Value2 = b.getElementsByTagName("P")(0).innerText 'キャッチコピー ActiveSheet.Range("F" & row).Value2 = b.getElementsByTagName("DIV")(1).Children(0).Children(1).Children(0).innerText '店舗名 ActiveSheet.Range("G" & row).Value2 = b.getElementsByTagName("DIV")(2).Children(1).Children(1).Children(0).innerText 'レビュー数 '// カウントアップ row = row + 1 End If
###該当のソースコード
VBA
1Option Explicit 2Private oIE As InternetExplorer 3 4Sub main() 5 6 '// 検索結果ページの読み込み開始 7 Call GetPage(2, "http://search.rakuten.co.jp/search/mall/%E3%83%AD%E3%83%BC%E3%82%BD%E3%83%95%E3%82%A1/") 8 9 '// 終了処理(IEを消す) 10 If Not oIE Is Nothing Then oIE.Quit 11 Set oIE = Nothing 12 13End Sub 14 15 16Sub GetPage(row, url) 17 18 '// ページ移動 19 Call Navigate(url) 20 21 '// 検索結果取得 22 Call getEarthQuakeList(row, oIE.document) 23 24 '// 次へ のリンクURLを取得 25 url = GetNextPage(oIE.document) 26 27 '// 次へ があれば、次へページを開く 28 If Len(Trim(url)) <> 0 Then Call GetPage(row, url) 29 30End Sub 31 32 33Sub Navigate(url) 34 35 '// IEの準備 36 If oIE Is Nothing Then Set oIE = New InternetExplorer 37 38 '// IEを表示 39 If oIE.Visible <> True Then oIE.Visible = True 40 41 '// ページ読み込み 42 oIE.Navigate2 (url) 43 44 '// 読み込みが完了するまで待つ 45 While oIE.readyState <> READYSTATE_COMPLETE Or oIE.Busy = True 46 DoEvents 47 Sleep 100 48 Wend 49 50 '// 読み込み完了後の安定化待ち 51 Sleep 200 52 53End Sub 54 55 56 57Function GetNextPage(oDoc As HTMLDocument) As String 58 Dim a As HTMLElementCollection 59 60 '// INIT 61 GetNextPage = "" 62 63 '// <div id="pageNextback"> 内の <A> タグをループする 64 For Each a In oDoc.getElementById("rsrPagerSect").Children(2).getElementsByTagName("A") 65 66 '// 次のページ の文字列が見つかったら、そのリンクを取得する 67 If a.innerText = "次のページ" Then 68 GetNextPage = a.href 69 Exit For 70 End If 71 Next a 72End Function 73 74 75 76Sub getEarthQuakeList(ByRef row, oDoc As HTMLDocument) 77 78 Dim a As HTMLElementCollection 79 Dim b As HTMLElementCollection 80 Dim flg As Boolean 81 Dim wk, i 82 83 84 '// 商品リストDIVを検索 85 flg = False 86 For Each a In oDoc.getElementsByTagName("div") 87 DoEvents 88 89 '// div タグの IDをチェック 90 wk = Split(a.ID) 91 For i = 0 To UBound(wk) 92 DoEvents 93 94 '// IDに ratArea が見つかったら 商品リスト 95 If UCase(wk(i)) = UCase("ratArea") Then flg = True 96 97 Next i 98 99 If flg <> False Then Exit For 100 Next a 101 102 103 '// 商品リストが見つからなかったら処理しない 104 If flg = False Then Exit Sub 105 106 107 '// 商品リストからエクセルに転記 108 For Each b In a.getElementsByTagName("div") 109 DoEvents 110 111 '// データ行のみ対象 112 If b.getAttribute("class") = "rsrSResultSect" Then 113 '// エクセルに転記する 114 ActiveSheet.Range("A" & row).Select 115 ActiveSheet.Range("A" & row).Value2 = row - 1 'No 116 ActiveSheet.Range("C" & row).Value2 = b.getElementsByTagName("DIV")(2).Children(0).href '詳細情報ページ 117 ActiveSheet.Range("D" & row).Value2 = b.getElementsByTagName("DIV")(2).Children(0).innerText '商品名 118 ActiveSheet.Range("E" & row).Value2 = b.getElementsByTagName("P")(0).innerText 'キャッチコピー 119 ActiveSheet.Range("F" & row).Value2 = b.getElementsByTagName("DIV")(1).Children(0).Children(1).Children(0).innerText '店舗名 120 ActiveSheet.Range("G" & row).Value2 = b.getElementsByTagName("DIV")(2).Children(1).Children(1).Children(0).innerText 'レビュー数 121 '// カウントアップ 122 row = row + 1 123 End If 124 Next b 125End Sub 126
###試したこと
getElements
やgetAttribute
などいろいろと取得条件を変えて試してみましたが上手く行きません。
###補足情報(言語/FW/ツール等のバージョンなど)
言語:VBA
64bit環境のため
Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private oIE As InternetExplorer
のうちDeclare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
は標準モジュールに移してあります。
参考ページのプログラムはコピペで動作できましたので実行環境はOKのはずです。
以上、何卒よろしくお願いいたします。
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2016/07/28 05:53