VBAにてGoogle検索結果を転記したい。

Question

本サイトでは、いつも教えて頂き、感謝をしております。
さて、本日も教えて頂きたく。

■　やりたい事。
下記の様に、B列に会社名が入っており、C列が空欄のシートがあります。

１．B列に記載されているセル内の文字を上から（B3の”トヨタ”から）抽出し、
２．Google検索にて検索し、検索最上位のURLを抽出し、
３．そのURL（”トヨタ”で検索した結果の最上位URL)を、C列（C3）に転記し、
４．B３のトヨタの処理が終了したら、 B４、B5、B6へと最終行まで、同様の処理を続けて、
５．C列最終行（C６）まで、転記が終了したら、作業を終了する。

■　試行錯誤の末、現時点でできている事。
「B３からB列最終行までのセル文字を、Google検索窓に自動挿入し、順次検索をする」と言う部分までは、出来ておりますが、「最上位検索結果を、C列に順次転記する」と言う部分がどうしてもできません。

■　現時点で、書いたコードは下記です。
ここから先の処理（プロシージャーは、分けた方が良いのでしょうか？）や、下記コードの誤り等を御指摘頂いた上、正しいコードを教えて頂きたく。
よろしくお願いします。
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Sub car_search()

'IEの起動
Dim objIE As Object '変数を定義します。
Dim xyz As String
Dim y As Integer

' 対象Sheet名は、Sheet2です。

Sheets("Sheet2").Select
Range("A1").Select

For y = 3 To Cells(Rows.Count, 2).End(xlUp).Row
xyz = Sheets("Sheet2").Cells(y, 2).Value
Debug.Print (xyz)
Set objIE = CreateObject("InternetExplorer.Application")

objIE.Visible = True '可視、Trueで見えるようにします。

'処理したいページを表示します。
objIE.navigate "http://www.google.co.jp/"

'ページの表示完了を待ちます。
While objIE.READYSTATE <> 4 Or objIE.Busy = True
'.ReadyState <> 4の間まわる。

Wend

objIE.document.getElementsByName("q")(0).Value = xyz

Call WaitFor(1)

Call IEButtonClick(objIE, "Google 検索")

Call WaitFor(5)

' IE終了
objIE.Quit

Next y

Set objIE = Nothing
End Sub

'ボタンを押す関数
Public Function IEButtonClick(ByRef objIE As Object, buttonValue As String)
Dim objInput As Object

For Each objInput In objIE.document.getElementsByTagName("INPUT")
If objInput.Value = buttonValue Then
objInput.Click
Exit For
End If
Next
End Function

'IEを待機する関数
Function IEWait(ByRef objIE As Object)
Do While objIE.Busy = True Or objIE.READYSTATE <> 4
DoEvents
Loop
End Function

'指定した秒だけ停止する関数
Function WaitFor(ByVal second As Integer)
Dim futureTime As Date
futureTime = DateAdd("s", second, Now)
While Now < futureTime
DoEvents
Wend

End Function
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Answer 1

Google Custom Search API を使ってください。

Google Custom Search API を使ってみる

Comments

[yujin1202]

御回答をありがとうございます。
ただ、PHPも出てきて、私にはまだ難しいです。
今後、頂いたリンクを読み解いてゆきたいと思います。
ありがとうございました。

Answer 2

基本的に、ベストアンサーに選んだコードの通りなのですが、実際のデータは何百行にも及ぶことがあり、「途中から再開する」事もあるので、Do While文を入れました。

下記が最終コードです。
ありがとうございました。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Sub URL_Search()
Dim objIE As Object
Dim rng As Range
Dim y As Integer
Dim xyz As String

' 対象Sheet名は、Sheet2です。
Sheets("Sheet2").Select

'※下記の２行はForループの外にだす（IEを繰り返し開いたり閉じたりするのは無駄）
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True    '可視、Trueで見えるようにします。

For y = 3 To Cells(Rows.Count, 2).End(xlUp).Row

   
 Do While Cells(y, 3) = ""  
'途中行で処理が止まった時は、空白行から再開できるように、Do While構文とした。
    
    xyz = Cells(y, 2).Value '検索語

    '※URLパラメータに検索語を埋め込めば、検索結果を表示できる
    objIE.navigate "https://www.google.co.jp/search?q=" & xyz

    IEWait objIE 'IEの読み込み待ち

    '※検索結果にはクラス名"rc"が付けられているので、その最初のURLを取得
    xyz = objIE.document.getElementsByClassName("rc")(0).GetElementsByTagName("a")(0).href
    

Cells(y, 3).Value = xyz 'URLをC列に出力

    Loop
    
Next y

' IE終了
objIE.Quit
Set objIE = Nothing

End Sub

Answer 3

現状のコードをなるべく活かしつつ、
間違っている部分、非効率的な部分、を修正しつつ、
最上位の検索結果のURLを出力するコードを追加してみました。

Sub car_search()
    Dim objIE As Object
    Dim rng As Range
    Dim y As Integer
    Dim xyz As String
    
    ' 対象Sheet名は、Sheet2です。
    Sheets("Sheet2").Select

    '※下記の２行はForループの外にだす（IEを繰り返し開いたり閉じたりするのは無駄）
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = True    '可視、Trueで見えるようにします。
    
    For y = 3 To Cells(Rows.Count, 2).End(xlUp).Row
        xyz = Cells(y, 2).Value '検索語

        '※URLパラメータに検索語を埋め込めば、検索結果を表示できる
        objIE.navigate "https://www.google.co.jp/search?q=" & xyz

        IEWait objIE 'IEの読み込み待ち

        '※検索結果にはクラス名"rc"が付けられているので、その最初のURLを取得
        xyz = objIE.document.getElementsByClassName("rc")(0).GetElementsByTagName("a")(0).href
        Cells(y, 3).Value = xyz 'URLをC列に出力

    Next y

    ' IE終了
    objIE.Quit
    Set objIE = Nothing
End Sub

'IEを待機する関数
Sub IEWait(ByRef objIE As Object)
    Do While objIE.Busy = True Or objIE.READYSTATE <> 4
        DoEvents
    Loop
End Sub

Comments

[yujin1202]

ありがとうございました。
コードは、とても明快で、分かり易いです。
それと、「IEを繰り返し開かない様に、Forの外に出す。」と言う部分も、なるほどです。
VBAでも、こんな事ができるのですねえ。。。
ありがとうございました。ベストアンサーとさせて頂きます。