「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件まで保存する、とか、指定できるとよいと思っています。

回答の条件
  • 1人10回まで
  • 登録:2007/02/18 14:59:02
  • 終了:2007/02/23 12:27:42

回答(5件)

id:hiroyuki_t No.1

hiroyuki_t回答回数7ベストアンサー獲得回数02007/02/20 22:58:26

ポイント20pt

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

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

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


注意

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

id:ysgear

ありがとうございます。

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

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

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

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

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

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

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

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

可能なのでしょうか?

2007/02/20 23:52:41
id:hiroyuki_t No.2

hiroyuki_t回答回数7ベストアンサー獲得回数02007/02/21 00:53:54

ポイント100pt

少し修正してみました。

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


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

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

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

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

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

id:ysgear

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

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

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

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

を書いてループさせる」

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

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


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

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

2007/02/21 14:28:28
id:hiroyuki_t No.3

hiroyuki_t回答回数7ベストアンサー獲得回数02007/02/21 19:08:52

ポイント100pt

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

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
id:ysgear

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

>

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

>

> '書き出し部分

>

> Call rwrite

>

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

上記の件については、


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


「省く部分」の件は、

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

うまくいくのですが、

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

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

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

2007/02/21 19:56:18
id:hiroyuki_t No.4

hiroyuki_t回答回数7ベストアンサー獲得回数02007/02/21 23:11:10

ポイント100pt

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

修正を行いました。

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

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


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

という件については

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

a = 1

b = 1

c = 1

id:ysgear

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

>

> 修正を行いました。

>

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

>

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

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



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

>

> という件については

>

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

>

> a = 1

>

> b = 1

>

> c = 1

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

また、

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

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

なってしまいました。

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

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

2007/02/22 00:15:39
id:hiroyuki_t No.5

hiroyuki_t回答回数7ベストアンサー獲得回数02007/02/22 23:17:14

ポイント100pt

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

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

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

また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
id:ysgear

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

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

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

2007/02/23 12:26:33
  • id:llusall
    面白そうだったので私も少し作ってみました。
    HTMLの取得を「XMLHTTP」で、内容の抽出を「正規表現」です。

    参考
    http://q.hatena.ne.jp/1171459385#a681647

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません