Excel VBAで検索結果を取得する方法
- Excel VBAを使用して、Googleの検索結果を取得する方法を教えてください。
- Googleの検索結果をExcelにコピーする方法を教えてください。
- 指定したキーワードを使用して、Excel VBAでGoogleを検索し、検索結果を取得する方法を教えてください。
- ベストアンサー
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 これから先、どう書いたらいいか教えてもらえないでしょうか？ よろしくお願いします！
- その他（プログラミング・開発）
- 回答数5
- ありがとう数4
- みんなの回答 （5）
- 専門家の回答
質問者が選んだベストアンサー
あとは単純だけどめんどくさい文字列操作だけです。 それくらいは何とかなりませんか 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
その他の回答 (4)
- kenpon24
- ベストアンサー率64% (66/102)
なぜ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
- kenpon24
- ベストアンサー率64% (66/102)
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ページ目も取得できるといいのですが…。
- kenpon24
- ベストアンサー率64% (66/102)
すみません。コピーした内容が混じりこんでしまったことに気付かず投稿してしまいました。 最初の5行とラスト10行くらいが本文です。
- kenpon24
- ベストアンサー率64% (66/102)
一例ですが 参照設定から 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 何故でしょうか？ おかしいところを教えて下さい。
関連するQ&A
- VBAでヤフー地図を検索して表示
インターネットエクスプローラーを開いて検索枠に検索語(ユーザーフォームのTextBox7)を入力後、 検索ボタンをクリックして画面が変わったら地図のタグをクリックして地図を表示するという作業 なのですがエラーが起きて困っています。 9月までは正常に動いていたのですが、10月に入ってからエラーが起きるようになりました。 エラーが起きる箇所ではgetelementbyidが使えないのではないかと思い、色々調べて試してみたのですが駄目でした。 どうか宜しくお願いします。 Sub Map_Search() Dim ie As New InternetExplorer 'IEオブジェクトの生成 ie.Navigate2 "http://yahoo.co.jp/" 'Yahooニューストップページ ie.Visible = True While (ie.Busy = True) Or (ie.ReadyState < READYSTATE_COMPLETE) '読み込み待ち DoEvents Wend With ie 'IE画面の大きさ調整 .Top = 0 .Left = 0 .Height = 1000 .Width = 1286 .Resizable = True End With ie.Document.getelementbyid("srchtxt").Value = TextBox7 '住所を入力 ←ここでエラーが起きる ie.Document.getelementbyid("srchbtn").Click '検索ボタンをクリック ←おそらくここでもエラーになる? While (ie.Busy = True) Or (ie.ReadyState < READYSTATE_COMPLETE) '読み込み待ち DoEvents Wend ie.Document.getelementbyid("map").Click '地図タグをクリック ←おそらくここでもエラーになる? End Sub
- 締切済み
- Excel（エクセル）
- VBAでヤフー地図を検索して表示
インターネットエクスプローラーを開いて検索枠に検索語(ユーザーフォームのTextBox7)を入力後、 検索ボタンをクリックして画面が変わったら地図のタグをクリックして地図を表示するという作業 なのですがエラーが起きて困っています。 9月までは正常に動いていたのですが、10月に入ってからエラーが起きるようになりました。 エラーが起きる箇所ではgetelementbyidが使えないのではないかと思い、色々調べて試してみたのですが駄目でした。 どうか宜しくお願いします。 Sub Map_Search() Dim ie As New InternetExplorer 'IEオブジェクトの生成 ie.Navigate2 "http://yahoo.co.jp/" 'Yahooニューストップページ ie.Visible = True While (ie.Busy = True) Or (ie.ReadyState < READYSTATE_COMPLETE) '読み込み待ち DoEvents Wend With ie 'IE画面の大きさ調整 .Top = 0 .Left = 0 .Height = 1000 .Width = 1286 .Resizable = True End With ie.Document.getelementbyid("srchtxt").Value = TextBox7 '住所を入力 ←ここでエラーが起きる ie.Document.getelementbyid("srchbtn").Click '検索ボタンをクリック ←おそらくここでもエラーになる? While (ie.Busy = True) Or (ie.ReadyState < READYSTATE_COMPLETE) '読み込み待ち DoEvents Wend ie.Document.getelementbyid("map").Click '地図タグをクリック ←おそらくここでもエラーになる? End Sub
- 締切済み
- Visual Basic
- エクセルのVBAで最終行までループする方法
エクセルのVBAで最終行までループする方法を教えてください。 下記がコードになります。 Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate Range("A1").Value While objIE.ReadyState <> 4 Or objIE.Busy = True DoEvents Wend Range("B1").value = objIE.Document.all("zoom1").href
- ベストアンサー
- オフィス系ソフト
- ExcelのVBAでGooglemapの検索
現在、ExcelのVBAでGooglemapにアクセスし、検索した後、検索結果の住所を抜き出すコードを書きましたが、うまくいきません。 具体的には、検索窓に検索ワードが表示されるだけで、検索結果が表示されませんでした。 そこで、検索文字が入力された状態で、検索ボタンを押すコードを付け加えましたが、 今度は、「オートメーションエラーです。エラーを特定できません」となりうまくいきません。 修正点のご指導の方、お願いいたします。 Sub 住所をmapで検索() Dim obIE As Object Dim el As Variant Dim button As HTMLInputElement Set obIE = CreateObject("InternetExplorer.Application") obIE.Visible = True obIE.navigate "https://www.google.co.jp/maps/place/原宿駅/" obIE.document.getElementById("searchbox-searchbutton").Click While obIE.readyState <> 4 Or obIE.Busy = True DoEvents Wend Set el = obIE.document.getElementsByClassName("widget-pane-link")(13) Cells(1, 1).Value = el.innerText End Sub
- 締切済み
- Visual Basic
- 住所を入力し、検索ボタンをクリックしたいのですが
グーグルマップを開き 住所を入力し、検索ボタンをクリックしたいのですが それをvbaで実現可能でしょうか? Dim objIE As Object Sub Sample() Dim myObj As Object Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.navigate "https://www.google.co.jp/maps" Do While objIE.Busy = True DoEvents Loop Do While objIE.document.readyState <> "complete" DoEvents Loop Set objIE = Nothing End Sub はできたのですが 「グーグルマップを検索する」が ソース内で見当たらないし さらに 検索ボタンもソース内で探せません。 グーグルの検索窓に「東京都千代田区丸の内1-9-1」 トイレたいのですが VBAでどうすればいいのでしょうか?
- ベストアンサー
- オフィス系ソフト
- VBAで教えてgooに自動ログインしたい
Sub 教えてgoo() Dim objIE As Object Const READYSTATE_COMPLETE As Long = 4 Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate "https://login.mail.goo.ne.jp/id/authn/LoginStart?Site=oshiete.goo.ne.jp&Success=http%3A%2F%2Foshiete.goo.ne.jp%2F" Do While objIE.Busy = True DoEvents Loop Do Until objIE.ReadyState = READYSTATE_COMPLETE Loop objIE.document.all.all("uname").Value = "gooID" objIE.document.all.all("pass").Value = "gooPW" Do While objIE.Busy = True DoEvents Loop Do Until objIE.ReadyState = READYSTATE_COMPLETE Loop objIE.document.all("ログイン").Click End Sub --------------------------------------------------------- を実行してみても、 objIE.document.all.all("uname").Value = "gooID" objIE.document.all.all("pass").Value = "gooPW" objIE.document.all("ログイン").Click の部分がエラーになってしまいます。 教えてgooは、VBAでログインできないように規制されてるのでしょうか？
- ベストアンサー
- オフィス系ソフト
- VBAからIEの操作
グーグルをIEで開いてVBA（語句）を検索して見終わったら IEを閉じる作業をしたいのですが、検索窓にVBA（語句）を 入力するところでエラーとなります。初心者ですが、なんとか 勉強したいのでよろしくお願いいたします。 Sub ie_test_Navigate() Dim objIE As Object Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "http://www.google.co.jp/" IE.document.all.q.Value = "VBA" IE.document.all.btnG.Click If MsgBox("IEを閉じますか？", vbYesNo, "終了確認") = vbYes Then objIE.Quit End If Set objIE = Nothing End Sub
- 締切済み
- Visual Basic
- 「地図」で検索するにはどういう操作をすればいいので
ヤフーのトップページから 値を入れて検索を押すまではできるのですが 「ウェブ」ではなく「地図」で検索するにはどういう操作をすればいいのでしょうか？ Sub yahoo() Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate "http://www.yahoo.co.jp/" Do While objIE.Busy = True DoEvents Loop Do While objIE.Document.ReadyState <> "complete" DoEvents Loop objIE.Document.forms(0).elements("p").Value = "東京" '‘「地図」をクリックする操作をしたい objIE.Document.forms(0).submit Set objIE = Nothing End Sub 宜しくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- DocumentCompleteイベントプロシジャに制御が渡らない
VB6(VBA)でIEを操作し、表示ページのソースの読込みの確認にDocumentCompleteイベントを使用することを考えています。それで下記のテストプログラムを作成しますたが、DocumentCompleteイベントプロシジャに制御が渡りません。 その原因をご教示して頂きたくお願いします。 Dim WithEvents objIE As InternetExplorer --------------------------------------------------------------- Private Sub CommandButton1_Click() Dim objIE As Object Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "http://www.yahoo.co.jp/" While objIE.readyState <> 4 While objIE.Busy = True DoEvents Wend Wend objIE.Navigate "http://www.goo.ne.jp/" While objIE.readyState <> 4 While objIE.Busy = True DoEvents Wend Wend End Sub ------------------------------------------------------------- Private Sub objIE_DocumentComplete(ByVal pDisp As Object, URL As Variant) MsgBox "ソースの読込み完了" End Sub
- 締切済み
- Visual Basic
- オブジェクト変数または With ブロック変数が設定されていません。
下記の様に組みましたが、下記の★印の所で止まる様な事があります。 毎回止まるわけではないのですが、止まる時に「オブジェクト変数または With ブロック変数が設定されていません。」と表示されますが、 原因は何か？どの様にすればいいのか？など詳しく教えてください。 よろしくお願いします。 Sub test() Dim objIE As Object Dim strCOMMENT As String Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "http://" While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop 'データをセットする 'htmlドキュメント フォーム(0番目) アイテムに転記(代入)する objIE.Document.forms(0).Item("username").Value = "11111" objIE.Document.forms(0).Item("password").Value = "11111" While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Document.all.subm.Click While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop For Each link In objIE.Document.Links If link.href = "http://" Then link.Click End If Next While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop 'タイトル・コメントの読み込み strtitle = Sheets("sheet1").Range("k7") strCOMMENT = Sheets("sheet1").Range("k9") Application.WindowState = xlMinimized While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Document.forms(0).Item("title").Value = strtitle objIE.Document.forms(0).Item("comment").Value = strCOMMENT While objIE.readystate <> 4 While objIE.busy = True DoEvents ' Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Document.all.submit.Click While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop 'フォーム(0番目)を .Submit(確認) する objIE.Document.forms(0).getElementsByTagName("input")(11).Click '←★この部分で止まる時があります。 While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop For Each link In objIE.Document.Links If link.href = "http://" Then link.Click End If Next While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 7, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Quit '.Quitで閉じる End Sub
- ベストアンサー
- Visual Basic
お礼
ありがとうございます！ 助かりました！！