本サイトでは、いつも教えて頂き、感謝をしております。
さて、本日も教えて頂きたく。
■ やりたい事。
下記の様に、B列に会社名が入っており、C列が空欄のシートがあります。
1.B列に記載されているセル内の文字を上から(B3の”トヨタ”から)抽出し、
2.Google検索にて検索し、検索最上位のURLを抽出し、
3.そのURL(”トヨタ”で検索した結果の最上位URL)を、C列(C3)に転記し、
4.B3のトヨタの処理が終了したら、 B4、B5、B6へと最終行まで、同様の処理を続けて、
5.C列最終行(C6)まで、転記が終了したら、作業を終了する。
■ 試行錯誤の末、現時点でできている事。
「B3から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
********************
回答3件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2018/04/03 13:01