人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

「EXCEL VBA」を使って、「Google(http://www.google.co.jp/)」で検索した検索結果のソースを読んで、「ホームページのタイトル」「URL」「紹介文」をエクセルファイルに保存する、というプログラムを作りたいと思っています。
どのようにプログラムを書けばいいのかわかりません。どなたか、ソースを書いていただけないでしょうか?


たとえば、エクセルのシートに「不動産」を入力して実行した場合、A列、B列、C列に、

Yahoo!<b>不動産</b>
http://realestate.yahoo.co.jp/
住まいを買いたい、借りたい、建てたい、リフォームしたい…Yahoo!<b>不動産</b>があなたの家探しをサポートします! 豊富な画像と間取り図で、新築マンション・新築一戸建ての最新物件情報も充実。

【楽天<b>不動産</b>】 全国の<b>不動産</b> 新築物件情報
http://house.www.infoseek.co.jp/
全国1004668件の豊富な<b>不動産</b>物件でお部屋探しをサポート。新築マンション、デザイナーズ物件、インテリアなど多彩な情報.

がどんどん保存されていけばよいと思います。

検索結果の1,000件まで保存する、とか、10,000件まで保存する、とか、30,000件まで保存する、とか、指定できるとよいと思っています。

●質問者: ysgear
●カテゴリ:コンピュータ インターネット
✍キーワード:Excel Google URL VBA Yahoo!
○ 状態 :終了
└ 回答数 : 5/5件

▽最新の回答へ

1 ● hiroyuki_t
●20ポイント

作ってみましたがこのようなものでしょうか?

参考になるとよいのですが

http://homepage3.nifty.com/takibouyou/comp/g2e.html


注意

実行後、少しの間操作できなくなりますので注意してください。

◎質問者からの返答

ありがとうございます。

このような感じです。いいと思います。

最初の10件以降も、100件とか

200件とか、登録するには、どうすればいいのでしょうか?

あと、データとしては、純粋に、

「ホームページのタイトル」「URL」「紹介文」

だけを抽出したいのですが、

「ホームページのタイトル」「URL」「紹介文」

をA列、B列、C列に、入れていくのは、

可能なのでしょうか?


2 ● hiroyuki_t
●100ポイント

少し修正してみました。

http://homepage3.nifty.com/takibouyou/comp/g2e.html


Googleの表示設定で表示を100件ずつにすれば

100件は取得できると思います。

それ以上行いたいのであれば検索結果ページの次へを押すスクリプトと

書き出し部分を書くスクリプト

を書いてループさせれば可能であると思いますので試してみてください。

◎質問者からの返答

確認いたしました。ありがとうございます。

修正してみようとしたのですが、

「検索結果ページの次へを押すスクリプトと

書き出し部分を書くスクリプト

を書いてループさせる」

というのができそうにありませんでした。

どのようにすればいいのでしょうか?


また、「紹介文」のなかから、

「realestate.yahoo.co.jp/ - 27k - 2007年2月19日 - キャッシュ - 関連ページ」の部分が不要なのですが、これを省くにはどうすればいいのでしょうか?


3 ● hiroyuki_t
●100ポイント

'検索結果ページの次へを押すスクリプト

Call link("text", "次へ")

'書き出し部分

Call rwrite

です。後はループさせてください。


省く部分は

かなり手抜きですが

下記のように直せば使えると思います。

Sub rwrite()

 a = 1
 b = 1
 c = 1
 
 objAll = targetFrame.document.getElementsByTagName("*")
 For idx = 0 To objAll.all.Length - 1

 If objAll.all.Item(idx).className = "l" Then
 ThisWorkbook.Sheets("画面").Cells(a, 1) = objAll.all.Item(idx).innerText
 ThisWorkbook.Sheets("画面").Cells(b, 2) = objAll.all.Item(idx)

 a = a + 1
 b = b + 1
 End If

 If objAll.all.Item(idx).className = "j" Then
 expl = objAll.all.Item(idx).innerText
 t = InStr(expl, Mid(ThisWorkbook.Sheets("画面").Cells(c, 2), 8, 12))
 ThisWorkbook.Sheets("画面").Cells(c, 3) = Left(expl, t - 1)
 c = c + 1
 End If
 
 Next idx
 
End Sub
◎質問者からの返答

> '検索結果ページの次へを押すスクリプト

>

> Call link("text", "次へ")

>

> '書き出し部分

>

> Call rwrite

>

> です。後はループさせてください。

上記の件については、


「for」「Next」を使ってループさせてみたのですが、次のページのデータを追加するべきなのに、前のページのデータを上書きしてしまいます。どうすれば、回避できますでしょうか?


「省く部分」の件は、

修正してみたのですが、10件ずつのときは、

うまくいくのですが、

Googleの表示設定を100件ずつにしたときに、

「実行時エラー'5' プロシージャの呼び出し、または引数が不正です。」

というエラーメッセージがでて、うまくいかないのですが、どうしたらいいのでしょうか?


4 ● hiroyuki_t
●100ポイント

上記では正しくデータ取得ができていなかったようなので

修正を行いました。

これで「省く部分」はうまく動くはずです。

http://homepage3.nifty.com/takibouyou/comp/g2e.html


> 次のページのデータを追加するべきなのに、前のページのデータ> を上書きしてしまいます

という件については

下記の部分をrwriteから削除してループよりも前に持っていってみてください。

a = 1

b = 1

c = 1

◎質問者からの返答

> 上記では正しくデータ取得ができていなかったようなので

>

> 修正を行いました。

>

> これで「省く部分」はうまく動くはずです。

>

> http://homepage3.nifty.com/takibouyou/comp/g2e.html

上記の件、おかげさまで、正しく取得できるようになりました。ありがとうございます。



> > 次のページのデータを追加するべきなのに、前のページのデータ> を上書きしてしまいます

>

> という件については

>

> 下記の部分をrwriteから削除してループよりも前に持っていってみてください。

>

> a = 1

>

> b = 1

>

> c = 1

上記の件は、「rwriteから削除してループよりも前に持っていって」みたのですが、

また、

「実行時エラー'5' プロシージャの呼び出し、または引数が不正です。」

というエラーメッセージがでて、うまくいかなく

なってしまいました。

どのようにしたらよいのでしょうか?

何度もほんとうにすみません。


5 ● hiroyuki_t
●100ポイント

さらに修正して取得件数を指定できるようになりました。

しかしこれで多すぎる取得件数を指定するのはお勧めしません。

取得件数を多くするとメモリ不足になることがあると思います。

またGoogleへの負荷の問題もあります。

10,000件超ものデータがほしいのであればGoogle Web APIの使用を検討したほうがよいと思います。


http://homepage3.nifty.com/takibouyou/comp/g2e.html


参考までにrwriteの修正版を載せておきます。

Private Sub rwrite()

 Set gsheet = ThisWorkbook.Sheets("画面")
 
 objAll = targetFrame.document.getElementsByTagName("*")
 For idx = 0 To objAll.all.Length - 1
 
 If write_row("画面", 3) - 2 >= number_of_items Then
 Exit For
 End If
 
 If objAll.all.Item(idx).className = "l" Then
 now_row = write_row("画面", 1)
 gsheet.Cells(now_row, 1) = objAll.all.Item(idx).innerText
 gsheet.Cells(now_row, 2) = objAll.all.Item(idx)
 End If

 If objAll.all.Item(idx).className = "j" Or objAll.all.Item(idx).className = "j hc" Then
 account = objAll.all.Item(idx).innerText
 End If
 
 If objAll.all.Item(idx).className = "a" And objAll.all.Item(idx).tagName = "SPAN" Then
 t = InStr(account, objAll.all.Item(idx).innerText)
 gsheet.Cells(now_row, 3) = Left(account, t - 1)
 End If
 
 Next idx
 
End Sub
◎質問者からの返答

ありがとうございました。

メモリ不足になるのですね。

おかげさまで、たいへん助かりました。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ