Googleの検索結果から任意の部分をリスト化するにはどうしたらいいでしょうか?


何かしらの語句で検索するとズラッと検索結果が出てきますが、
その中の任意の要素(サイトのタイトル、URL、説明文など)を(個別に)抽出して一覧リスト(できればCSVなど)にできるようなソフトかWebサービスは存在しますでしょうか?

簡単に言えば、検索結果をエクセル表に手動で移植する手間を自動化したい、という感じです。
検索結果が10件とか20件とかなら手動でもかまいませんが、これが数千件にもなると手動では無理なので、こうしたことが自動で出来る方法を探しております。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2009/05/26 18:01:31
  • 終了:2009/05/29 19:19:53

ベストアンサー

id:ardarim No.1

ardarim回答回数897ベストアンサー獲得回数1452009/05/26 23:13:58

ポイント300pt

Excel VBAで書いてみましたが、どうでしょう。

ちょっと泥臭いのでGoogleの仕様が変わったら使えなくなりそうですが...

Option Explicit

Sub test()

    ' 検索キーワードと最大件数を指定
    Call GoogleQuery("検索キーワード", 1000)

End Sub

Sub GoogleQuery(ByVal queryWord As String, ByVal rmax As Long)

    Dim r As Long
    Dim n As Long
    Dim txt As String
    Dim nas As Long, nae As Long
    Dim nts As Long, nte As Long
    Dim queryUrl As String
    Dim pg As Long
    Dim i As Long
    Dim n1 As Long, n2 As Long
    
    Cells.Clear
    
    pg = 0
    r = 1
    Do While r <= rmax
        queryUrl = BuildQueryString(queryWord, pg)
        
        If Not GetUrl(queryUrl, txt) Then
            Exit Do
        End If
    
        txt = StrConv(txt, vbUnicode)
        
        i = 0
        n = InStr(1, txt, "class=g>")
        Do While n <> 0 And r <= rmax
            nas = InStr(n, txt, "<a href=""") + 9
            nae = InStr(nas, txt, """")
            nts = InStr(nae, txt, ">") + 1
            nte = InStr(nts, txt, "</a>")
            Cells(r, 1).Value = Mid$(txt, nas, nae - nas)
            Cells(r, 2).Value = Mid$(txt, nts, nte - nts)
            n1 = InStr(nte, txt, "class=g>")
            n2 = InStr(nte, txt, "class=g ")
            If n2 = 0 Then
                n = n1
            Else
                n = WorksheetFunction.Min(n1, n2)
            End If
            r = r + 1
            i = i + 1
        Loop

        If i = 0 Then Exit Do
        pg = pg + 1
    Loop
    
End Sub

Function BuildQueryString(ByVal queryWord As String, ByVal pg As Long) As String

    Dim i As Long
    Dim c As String
    Dim queryUrl As String
    
    queryUrl = "http://www.google.com/search?"
    If pg > 0 Then
        queryUrl = queryUrl & "start=" & Format(pg * 50, "0")
    End If
    queryUrl = queryUrl & "&num=50&hl=ja&lr=lang_ja&ie=Shift_JIS&oe=Shift_JIS&"
    queryUrl = queryUrl & "q="
    For i = 1 To Len(queryWord)
        c = Mid$(queryWord, i, 1)
        If Asc(c) >= 32 And Asc(c) < 128 Then
            queryUrl = queryUrl & c
        Else
            c = StrConv(c, vbFromUnicode)
            queryUrl = queryUrl & "%" & Right$("0" & Hex$(AscB(LeftB$(c, 1))), 2) & "%" & Right$("0" & Hex$(AscB(RightB$(c, 1))), 2)
        End If
    Next i

    BuildQueryString = queryUrl

End Function

Function GetUrl(ByVal url As String, text As String) As Boolean

    Dim xmlhttp As Object
    Dim ern As Long
    
    GetUrl = False
    
    On Error Resume Next
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    If Err.Number <> 0 Then
        Set xmlhttp = CreateObject("MSXML.XMLHTTPRequest")
    End If
    On Error GoTo 0
    
    On Error Resume Next
    xmlhttp.Open "GET", url, False
    On Error GoTo 0
    On Error Resume Next
    xmlhttp.Send
    ern = Err.Number
    On Error GoTo 0
    If ern = &H80070005 Then
        Set xmlhttp = Nothing
        Exit Function
    End If
    
    If (xmlhttp.Status < 200 Or xmlhttp.Status > 399) And xmlhttp.Status <> 503 Then
        Set xmlhttp = Nothing
        Exit Function
    End If
    
    text = xmlhttp.responsebody
    GetUrl = True

    Set xmlhttp = Nothing
    
End Function

URLはダミー

http://q.hatena.ne.jp/1243328489

id:popJP

ありがとうございます!

ただ、これはどうやって使ったらいいのでしょう?

エクセル2000のVBエディタを開いて「標準モジュール」にこのコードを貼り付け、実行してみました。

すると、

シート1のB1セルに「テストのニュース検索結果」、

B2セルには「テスト の動画検索結果」

そしてA1とA2には http://google.com~(クエリストリングいろいろ) と入っています。

私はVBAは全くと言っていいほど分からないのですが、ソースをざっと見る限りGoogleから1000件のデータを取って来そうな感じに見えますが、その1000件というのはシートどこに入るのでしょうか・・・??

2009/05/26 23:55:56
  • id:ryota11
    そんなもん数千件もエクセルにしてどうするんですかww
    もっかいググればいいだけなのに
    すごく気になります
  • id:ardarim
    正常に動作した場合はA列にURL、B列にタイトルという形式で最大1000行のセルが出力されます。こんな感じになるはずです。
    http://f.hatena.ne.jp/ardarim/20090527001542

    Excel2003での場合ですが、Visual Basic Editorを起動後、VBAProject (ブック名) のThisWorkbookを選択(ダブルクリック)し、プログラムをコピペし、Excelに戻ってThisWorkbook.testマクロを実行します。
    Excel2000でも動くとは思うのですが、環境がないので確認はしていません。
  • id:popJP
    >ardarim さん

    ありがとうございます! 教えていただいた通りにやってみたら出来ました!!
    あと、これは現状では「1~1000件目を検索する」という仕様かと思いますが、なぜか実際の検索結果(シートに表示される件数)は500~600件しかなかったりします。なぜでしょうか…??

    また、たとえば「1001件目から●●件」を検索するには、ソースのどこを変更したら良いでしょうか。
    なんだかレベルの低い質問ばかりですみません。
  • id:ardarim
    検索結果が1000件未満しかない場合は500~600件で終わります。
    プログラム中でサンプルで書いた「検索キーワード」で検索した場合は最大で793件になります。

    http://www.google.com/search?&start=100&num=50&hl=ja&lr=lang_ja&ie=Shift_JIS&oe=Shift_JIS&q=%8C%9F%8D%F5%83%4C%81%5B%83%8F%81%5B%83%68
    という検索URLで「start=100&num=50」という部分が、「100件目から50件分」を指定していることになります。この数字を変えると好きな範囲で表示できますが、検索結果の数より大きい数を指定した場合、常に同じ結果(一番最後の検索ページ)の内容が返ってきます。最後のページになると、次のページがあるように表示はされますが、次のページを開いていっても、ページの右上の「○○件~○○件」の部分が変わらなくなります。

    ですので、よく見るとExcelシートの最後の方(検索結果の数を越えた部分)は同じデータが繰り返しになってしまっています…

    ちなみに「start=1000」にした場合、
    「大変申し訳ございませんが、Google では 1000 件以上の検索結果は表示しておりません (1000 件目以降の結果をリクエストされました)。」
    と表示されるようです。そうなんだ・・・

  • id:popJP
    ありがとうございます。

    >検索結果が1000件未満しかない場合は500~600件で終わります。

    とのことなのですが、たとえば「inurl:.jp」で検索した場合、ワークシートに入ったのは839件でした。
    本当は1000件以上あるはずなのですが・・・。

    他にもたとえば「テスト」で検索した場合も932件と、いずれも1000件に届きません。

    こちらのエクセルのバージョンの問題でしょうか?



    >Excelシートの最後の方(検索結果の数を越えた部分)は同じデータが繰り返し

    この現象はこちらでも確認できました。
    ただし、いただいたソースコードのままで実行(すなわち1~1000件目を検索)し、しかもその結果が500~600件しかワークシートに出てこない(本来は1000件以上結果がある)場合において、そのように何回も繰り返しのデータが出現しました。
  • id:ardarim
    取得した文字列が「=」で始まる場合に、Excelが数式と誤認識してエラー終了してしまっていたようです。
    43行目を以下のように直してみてください。(「"'" & 」を追加)

    Cells(r, 2).Value = "'" & Mid$(txt, nts, nte - nts)

    ついでに55行目を以下のように直すと(「i = 0」を「i < 50」に変更)、1000件未満の場合に何回も繰り返す問題を解決するはずです。

    If i < 50 Then Exit Do

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

トラックバック

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

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

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