Excel VBAで検索結果を取得するにはどうしたらいいですか？

質問

今、Googleの検索結果をコピーして、Excelに貼り付けたいと思って
います。

IEで検索するところまで書けたのですが、それ以上がわかりません。

Sub shutoku()
With CreateObject("InternetExplorer.application")
.Visible = True
.navigate ("http://www.google.co.jp/")
While .Busy Or .readyState <> 4
DoEvents
Wend
.document.all.q.Value = "指定のキーワードを入れる"
.document.all.btnG.Click
End With
End Sub

これから先、どう書いたらいいか教えてもらえないでしょうか？

よろしくお願いします！

回答No.5

kenpon24 · ベストアンサー

あとは単純だけどめんどくさい文字列操作だけです。
それくらいは何とかなりませんか

Dim LINES As Variant
Dim LINE As Variant
Dim i As Long

'Set myDoc以下をこんな感じで
Set myDoc = .document

'改行で分ける
LINES = Split(Trim(myDoc.body.innerHTML), vbCrLf)
i = 1
For Each LINE In LINES
LINE = Trim(LINE)
If LINE <> "" And LINE Like "<H3*" Then
Range("A" & i) = LINE
i = i + 1
End If
Next

お礼

ありがとうございます！
助かりました！！

回答No.4

kenpon24

なぜ2回もCreateObjectしているのかが謎なんですが・・・
2ページ目は.navigateで移動してあげればいいだけです。

とはいえ2ページ目のアドレスはどこ？となるわけで実験してみました。
結果、最初に検索したURLに
&start=XX&sa=N (XXが可変)をつければ任意のページを表示できることがわかりました。
&start=0&sa=N なら1-10件
&start=10&sa=N なら11-20件
&start=20&sa=N なら21-30件

最初に検索したときのアドレスを覚えておいて、上記の文字列を付加して.navigateすれば好きなページを取得できるでしょう。

Dim BaseURL as string
Set myDoc = .document
BaseURL = myDoc.URL
Range("A1") = Trim(myDoc.body.innerText)

'ちょっとウェイトを入れる
Application.Wait Now + TimeValue("00:00:01")

'2ページ目に移動
.navigate (BaseURL & "&start=10&sa=N")

While .Busy Or .readyState <> 4
DoEvents
Wend

Set myDoc = .document
Range("B1") = Trim(myDoc.body.innerText)

お礼

すみません…。
これ、A1に全部固まってしまうので、何とかしたいのですが、
方法ありますでしょうか？

あと、URLだけ取得するって可能ですか？

Sub shutoku()
Dim myDoc As MSHTML.HTMLDocument

With CreateObject("InternetExplorer.application")

.Visible = True
.navigate ("http://www.google.co.jp/")

While .Busy Or .readyState <> 4

DoEvents

Wend
.document.all.q.Value = "link:http://blogs.yahoo.co.jp/kohaku3578"
.document.all.btnG.Click

While .Busy Or .readyState <> 4
DoEvents

Wend

Set myDoc = .document

Set myDoc = Nothing

Dim BaseURL As String

Set myDoc = .document

BaseURL = myDoc.URL

Range("A1") = Trim(myDoc.body.innerText)

'ちょっとウェイトを入れる
Application.Wait Now + TimeValue("00:00:01")

'2ページ目に移動
.navigate (BaseURL & "&start=10&sa=N")

While .Busy Or .readyState <> 4
DoEvents
Wend

Set myDoc = .document
Range("B1") = Trim(myDoc.body.innerText)

Range("A1") = Trim(myDoc.body.innerText)

End With

End Sub

回答No.3

kenpon24

URLを取得したかったんですか？
検索結果と言うので、検索した結果表示された文章、またはHTMLソースを取得したいモノと思ったのですが。

Set myDoc = .document以下のDebug.printを以下に変更して表示される内容を確認してみてください

Range("A1") = Trim(myDoc.body.innerText)
Range("B1") = Trim(myDoc.body.outerHTML)
Range("C1") = Trim(myDoc.body.innerHTML)
Range("D1") = Trim(myDoc.URL)

お礼

ありがとうございます！

Sub shutoku()
Dim myDoc As MSHTML.HTMLDocument
With CreateObject("InternetExplorer.application")
With CreateObject("InternetExplorer.application")
.Visible = True
.navigate ("http://www.google.co.jp/")
While .Busy Or .readyState <> 4
DoEvents
Wend
.document.all.q.Value = "link:http://blogs.yahoo.co.jp/kohaku3578"
.document.all.btnG.Click
While .Busy Or .readyState <> 4
DoEvents
Wend
Set myDoc = .document
Range("A1") = Trim(myDoc.body.innerText)
End With
End With
Set myDoc = Nothing
End Sub

あと、これで2ページ目も取得できるといいのですが…。

回答No.2

kenpon24

すみません。コピーした内容が混じりこんでしまったことに気付かず投稿してしまいました。
最初の5行とラスト10行くらいが本文です。

回答No.1

kenpon24

一例ですが

参照設定から
Microsoft HTML Object Libraryを参照する

Dim myDoc As MSHTML.HTMLDocument

With CreateObject("InternetExplorer.application")
.
.
.
今、Googleの検索結果をコピーして、Excelに貼り付けたいと思って
います。

IEで検索するところまで書けたのですが、それ以上がわかりません。

Sub shutoku()
With CreateObject("InternetExplorer.application")
.Visible = True
.navigate ("​http://www.google.co.jp/")​
While .Busy Or .readyState <> 4
DoEvents
Wend
.document.all.q.Value = "指定のキーワードを入れる"
.document.all.btnG.Click

While .Busy Or .readyState <> 4
DoEvents
Wend

Set myDoc = .document

debug.print myDoc.body.innerText
debug.print myDoc.body.innerHTML
debug.print myDoc.body.outerHTML

End With

set myDoc = Nothing

End Sub

後は得られた結果からお好みでどうぞ

お礼

ありがとうございます！
ただ、以下のソースだと、エクセルにURLをコピペできません
でした…。

Sub shutoku()
Dim myDoc As MSHTML.HTMLDocument
With CreateObject("InternetExplorer.application")
With CreateObject("InternetExplorer.application")
.Visible = True
.navigate ("http://www.google.co.jp/")
While .Busy Or .readyState <> 4
DoEvents
Wend
.document.all.q.Value = "指定のキーワードを入れる"
.document.all.btnG.Click
While .Busy Or .readyState <> 4
DoEvents
Wend
Set myDoc = .document
Debug.Print myDoc.body.innerText
Debug.Print myDoc.body.innerHTML
Debug.Print myDoc.body.outerHTML
End With
End With
Set myDoc = Nothing
End Sub

何故でしょうか？
おかしいところを教えて下さい。