みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

よろしくお願いします!

投稿日時 - 2009-04-20 18:00:39

QNo.4895127

すぐに回答ほしいです

質問者が選んだベストアンサー

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

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

投稿日時 - 2009-04-21 15:05:00

お礼

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

投稿日時 - 2009-04-21 15:13:37

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.4

なぜ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)

投稿日時 - 2009-04-21 13:05:41

お礼

すみません…。
これ、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

投稿日時 - 2009-04-21 14:31:35

ANo.3

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)

投稿日時 - 2009-04-21 00:46:50

お礼

ありがとうございます!

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ページ目も取得できるといいのですが…。

投稿日時 - 2009-04-21 12:00:11

ANo.2

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

投稿日時 - 2009-04-20 20:26:07

ANo.1

一例ですが

参照設定から
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

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

投稿日時 - 2009-04-20 20:21:25

お礼

ありがとうございます!
ただ、以下のソースだと、エクセルに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

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

投稿日時 - 2009-04-20 22:23:34

あなたにオススメの質問