Google検索をして、その下に検索結果(URL)を表示

A列1行から、ずっと右へキーワードが記入されています。
調べたいキーワードは、400近くあります。

その1行目にあるキーワードをGoogle検索をして、
検索結果のURLだけを、そのキーワードの下に表示させたいです。

検索結果は全部で10ページくらい、大体100個のURLになるかと思います。
(youtube動画や広告などは含めないです)

このようなことは、Excelのマクロでできるでしょうか?
できるとしたら、どのようなマクロの記述になるでしょうか?

Excel２０１６です。
よろしくお願いいたします。

No.4 ベストアンサー 回答者： WindFaller 回答日時： 2019/04/19 19:34

すみません。

体調を壊していて、細かい作業ができません。
うまくいくかは別として、当面の進捗状態をみるために、コードを挙げておきます。
この手の規模のものは、参照設定をしないと負担が大きいと思います。
以下に「ページ数」となっていますから、「1 to 5」の そこがページ数です。
小分けにしたほうが安全です。一気にしようとして失敗すると、せっかくの取得したものも失いかねません。
起動はMain()からです。

それから、BASEURL のGoogle URLの末尾は、?q=　ダブルクォーテーションです。掲示板では文字が変わる可能性があります。


'//標準モジュール
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Dim objIE As SHDocVw.InternetExplorer '参照設定 Microsoft Internet Contorls
Dim oHTML As HTMLDocument '参照設定 Microsoft HTML Object Library
Sub Main()
　Dim c As Range
　Dim enSrTxt As String
　Dim counter As Long
　On Error GoTo ErrHandler
　Const BASEURL As String = "https://www.google.co.jp/search?q="
　With ActiveSheet
　　Set objIE = Nothing
　　For Each c In .Range("A1", .Cells(1, Columns.Count).End(xlToLeft))
　　　If c.Value <> "" Then
　　　　If c.Value Like "*[ぁ-龠]*" Then
　　　　　enSrTxt = EnUtf8(c.Value)
　　　　Else
　　　　　enSrTxt = c.Value
　　　　End If
　　　　Call getIE(BASEURL & enSrTxt)
　　　　Application.Wait TimeSerial(0, 0, 10) '休み
　　　　counter = counter + 1
　　　End If
　　Next c
　End With
ErrHandler:
　If Err <> 0 Then
　　MsgBox Err.Description 'エラー出力
　End If
End Sub

Sub getIE(ByVal strURL As String)
　Dim cnt As Long
　Dim cl As Object
　Dim c As Range
　Dim nm As Long
　Set oHTML = New HTMLDocument
　If objIE Is Nothing Then
　　Set objIE = New SHDocVw.InternetExplorer
　End If

　Set c = Cells(2, Columns.Count).End(xlToLeft) '二行目で計る
　If c.Value <> "" Then nm = c.Column + 1 Else nm = c.Column

　With objIE
　　.Visible = True
　　.navigate strURL
　　Do While .Busy Or .readyState <> 4: DoEvents: Loop
　　Set oHTML = .document
　End With

　For cnt = 1 To 5 'ページ数
　　Call outputLog(oHTML, nm)
　　Set cl = objIE.document.getElementsByClassName("csb ch")
　　cl(cnt).Click
　　DoEvents
　　Sleep 500
　　Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
　　Set oHTML = objIE.document
　Next cnt
　Cells(1, nm).EntireColumn.AutoFit
　Application.ScreenUpdating = True

End Sub
Sub outputLog(oHTML As HTMLDocument, nm As Long)
　Dim buf As Variant
　Dim j As Long, i As Long, k As Long
　Dim gLinks As Object

　j = Cells(Rows.Count, nm).End(xlUp).Row + 1

　With oHTML
　　Set gLinks = oHTML.getElementsByClassName("TbwUpd")
　　If gLinks.Length > 0 Then
　　　For i = 0 To gLinks.Length - 1
　　　　buf = gLinks(i).ParentNode.href
　　　　If InStr(1, buf, "%") > k Then buf = DecodeUTF8(buf)
　　　　Cells(j, nm).Value = buf
　　　　j = j + 1

　　　　buf = ""
　　　Next
　　End If
　End With
End Sub


Public Function EnUtf8(ByRef strSource As String) As String
　'Encode
　Dim objSC As Object
　Set objSC = CreateObject("ScriptControl")
　objSC.Language = "Jscript"
　EnUtf8 = objSC.CodeObject.encodeURIComponent(strSource)
　Set objSC = Nothing
End Function

Function DecodeUTF8(ByVal strSearch As String)
　'Decord
　If strSearch = "" Then Exit Function
　With CreateObject("ScriptControl")
　　.Language = "JScript"
　　With .CodeObject
　　　DecodeUTF8 = .decodeURI(strSearch)
　　End With
　End With
End Function

No.3 回答者： WindFaller 回答日時： 2019/04/13 13:16

ちょっと後で気になったのですが、私の言葉が足りなかったようです。

私が確認したいことは、

「「VBA」で検索して、3ページ目あたりで、
https://www.amazon.co.jp/できる-イラストで学ぶ-入社1年目からのExcel-VBA-できるイラストで学ぶシリーズ/dp/4295005231
というURLが出てきます。」

検索して貼り付けると、UTF-8になってしまいます。そうすると、事実上、日本字の部分は3倍近くの横の広がりになります。だから、Decode して、SJIS にすると上記のようになるけれど、よろしいですか、と言いたかったのです。

・もう一つは、メモリ配分とかは、こちらが検討はしますが、それでも、4万件は、負担が大きすぎます。おそらく、途中で止まってしまう予想が高いです。分散していただいたほうが良いと思いますが、その案についてはどうでしょうか?　（ブックを分散するか、時間的に間を空けるか等)
Googleは、IE オートメーションでしか取れないのか、スクレイピングを防いでいるのかもしれません。

以下添付画像は、3ページ分です。

この回答へのお礼

返信ありがとうございます。

はい、私がしたいと思っているのは、
貼っていただいた画像の通りです。

Excelからリンクを飛んで確認するだけなので、
URL内の日本語の表示に、こだわりはないです。

ただ、URLの確認のため、日本語になっているとありがたいです。


検索結果を、実際に手動でやってみると、
途中で、チェックを入れる「確認のページ」に飛びますね。

なので、時間を開けて、分散をしてやるべきのようです。


実際にマクロを書いていただいたようで、
画像も貼っていただいて、感謝します。

WindFallerさん、ありがとうございます！

お礼日時：2019/04/13 20:02

No.2 回答者： WindFaller 回答日時： 2019/04/12 00:07

>検索結果は全部で10ページくらい、大体100個のURLになるかと思います。

1ページで、10個ぐらいで、それを、10ページ。それを400個のキーワードですから、4万件とは、Google なら、訴えられることはないでしょうけれども、かなり負担の多いマクロです。5千ごと（検索単語50個)とか、休み休み行ったほうがよいのではないでしょうか。それと、有線Lan で行うとか、工夫しないといけないのではないでしょうか。

それにしても、4万件のURLといのは、尋常ではないように思います。

残念なことに、IE以外には取れそうにないし、詳しくは知りませんが、もし、Google APIが使える方がいるなら、そちらの方にお任せします。winHttp でとろうとしたら、エラーコード403（見てはいけない!)　だそうです。

こちらは、今の所、開発中途で、細かい部分を調べないと、いつまでも、トラブルが続きそうです。
以前もGoogleをExcelで取得することはあるけれども、こんなに入り組んでいる内容ではなかったと思います。難しくなったようです。

それと、細かいことですが、Google では、URLは、そのサイトのホームページだけではない
ので、例えば、書名などは、UTF-8 にすると、理論的には、日本語の三倍の長さになってしまいます。そこで、シートのセルに貼り付けは、デコードするのが良いのではないかと思います。セル内で折返しを使わない限りは、ひとつのURLで、画面一般になるものがあります。

「VBA」で検索して、3ページ目あたりで、
https://www.amazon.co.jp/できる-イラストで学ぶ-入社1年目からのExcel-VBA-できるイラストで学ぶシリーズ/dp/4295005231
というURLが出てきます。一度、こちらの書き込みにコメントをいただけましたら、当面の完成品をアップロードします。

この回答へのお礼

回答ありがとうございます。

いろいろ調べて、自分でできるかもしれない。
と思いましたが、あまりに難しくて無理でした・・・。


> 「VBA」で検索して、3ページ目あたりで、
> https://www.amazon.co.jp/できる-イラストで学ぶ-入社1年目からのExcel-VBA-できるイラストで学ぶシリーズ/dp/4295005231
> というURLが出てきます。一度、こちらの書き込みにコメントをいただけましたら、当面の完成品をアップロードします。

これは、amazonの書き込みにコメントをするということでしょうか？
よろしくお願いいたします。

お礼日時：2019/04/13 11:25

No.1 回答者： fujillin 回答日時： 2019/04/11 16:52

こんにちは

試してはいませんので、確かではありませんが、
ありそうな方法として2種類。

◇方法（1）
IEを利用して検索・表示させて、その内容からURL等を取得し、ワークシートに転記する。
https://www.vba-ie.net/
https://www.sejuku.net/blog/72067
（2番目で取り上げている例が、Google検索になっています）

似た方法での例と思われるもの
https://teratail.com/questions/77171
※ この方法での例や解説は、検索すれば数多く見つかるものと思います。


◇方法（2）
Googleの検索APIを利用して、直接検索結果を取得し（Json等）、ワークシートに転記する。
https://qiita.com/megu_ma/items/8cad39f61e35588e …
https://webbigdata.jp/what-is-bigdata/google-cus …
https://developers.google.com/custom-search/v1/o …
（3番目はGoogleのドキュメント）

似たようなことを試みている例と思われるもの
https://stackoverflow.com/questions/53364454/vba …