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

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

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

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

●質問者: popJP
●カテゴリ:インターネット ウェブ制作
✍キーワード:CSV Google URL Webサービス エクセル
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● ardarim
●300ポイント ベストアンサー

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

◎質問者からの返答

ありがとうございます!

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

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

すると、

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

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

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

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

関連質問


●質問をもっと探す●



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