質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Windows

Windowsは、マイクロソフト社が開発したオペレーティングシステムです。当初は、MS-DOSに変わるOSとして開発されました。 GUIを採用し、主にインテル系のCPUを搭載したコンピューターで動作します。Windows系OSのシェアは、90%を超えるといわれています。 パソコン用以外に、POSシステムやスマートフォンなどの携帯端末用、サーバ用のOSもあります。

Q&A

解決済

1回答

2829閲覧

VBAで検索結果のスクレイピング

Qual

総合スコア13

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Windows

Windowsは、マイクロソフト社が開発したオペレーティングシステムです。当初は、MS-DOSに変わるOSとして開発されました。 GUIを採用し、主にインテル系のCPUを搭載したコンピューターで動作します。Windows系OSのシェアは、90%を超えるといわれています。 パソコン用以外に、POSシステムやスマートフォンなどの携帯端末用、サーバ用のOSもあります。

0グッド

0クリップ

投稿2016/07/28 04:12

###前提・実現したいこと
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

###試したこと
getElementsgetAttributeなどいろいろと取得条件を変えて試してみましたが上手く行きません。

###補足情報(言語/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のはずです。

以上、何卒よろしくお願いいたします。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

対象にしている楽天のページのソースを見たところ、classがrsrSResultSectのものは無いようです。
代わりにあるのは、rsrSResultSectPr clfxrsrSResultSect clfxです。
たぶん必要としているのは後者でしょうか。
試しにIf文を次のようにしたところ、中に入ることは確認できましたが、そのあとでエラーが発生しています。

VB

1If b.getAttribute("class") = "rsrSResultSect clfx" Then

とりあえず質問の「動いていない」というところは解決できるかと思います。

投稿2016/07/28 05:08

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Qual

2016/07/28 05:53

早速のご回答ありがとうございます。 ご指摘頂いた箇所を修正し、無事にif文のtrueの値は得られました。 また `'// エクセルに転記する`以降の文については自己解決しました。 同様のプログラムを作ろうとしている方のために記載しておきます。 For Each b In a.getElementsByTagName("div") DoEvents '// データ行のみ対象 If b.getAttribute("class") = "rsrSResultSect clfx" Then row = 2 '// エクセルに転記する ActiveSheet.Range("A" & row).Select ActiveSheet.Range("A" & row).Value2 = row - 1 'No ActiveSheet.Range("B" & row).Value2 = b.getElementsByTagName("a")(0).href '商品URL ActiveSheet.Range("C" & row).Value2 = b.getElementsByTagName("a")(1).innerText '詳細情報ページ ActiveSheet.Range("D" & row).Value2 = b.getElementsByTagName("a")(2).innerText '店舗名 ActiveSheet.Range("E" & row).Value2 = b.getElementsByTagName("a")(4).innerText 'レビュー件数 ActiveSheet.Range("F" & row).Value2 = b.getElementsByTagName("a")(5).innerText '価格 '// カウントアップ row = row + 1 End If Next b
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問