私ならばIEを起動せずに直接取得します
作って動作させたコードを載せてますが、
検索パターンは対象としているサイトの内部構造にあわせる必要があります
Option Explicit Sub MySearch() ' 'メインとして呼び出すマクロ ' ' 定数 Const targetList = "A": 'URLの入っている列 Const searchKeyward = "B": '検索キーワードの入っている列 Const resultText = "C": '結果を格納する列 ' 変数準備 Dim startRow As Long, lastRow As Long startRow = 2: ' コメント欄のコードにあわせてA2からURLが記載されているものとする 'このマクロはアクティブなシートを対象として動作するものとする With ActiveSheet lastRow = .Cells(.Rows.Count, targetList).End(xlUp).Row: 'URLの列を見てデータの最終行を求める If lastRow < startRow Then Exit Sub: 'URLの記載が無ければプログラム終了 '作業ループ Dim nowRow As Long: '作業中の行(ループで使用するため初期値ありません) For nowRow = startRow To lastRow .Cells(nowRow, resultText).Value = MyHttpRequest(.Cells(nowRow, targetList).Value, .Cells(nowRow, searchKeyward).Value) Next nowRow End With '終了メッセージ MsgBox "終了しました" End Sub Function MyHttpRequest(targetURL As String, searchKeyward As String) As String ' サイトからキーワードを含む文字列を抜き出す関数 ' 変数準備 Dim x As Object, r As Object, m As Variant 'バインディング Set x = CreateObject("MSXML2.XMLHTTP") Set r = CreateObject("VBScript.RegExp") '情報取得 x.Open "GET", targetURL, False x.send (Null) '抽出 r.Pattern = "。.*?" & searchKeyward & ".*?。": '抽出パターン r.IgnoreCase = True: '大文字小文字を区別しない r.Global = False: '最初に見つかった文字列だけを対象とする Set m = r.Execute(x.responseText): '実行 If m.Count > 0 Then MyHttpRequest = Mid(m(0).Value, 2) Else MyHttpRequest = "見つかりませんでした" End If ' 開放 Set m = Nothing Set r = Nothing Set x = Nothing End Function
情報収集部分を関数として分離してありますので、
どの部分で何を行っているのかを理解しやすいと思いますし、
サイトにあわせて関数を複数種類用意するということも容易になろうかと思います
IEを起動して操作するという動作コストが高すぎるため、
コメント欄のコードは情報収集用途には向きませんし、
適当に繋ぎ合わせてあるため、修正すべき点も多く、修正は行ってません
http://www2s.biglobe.ne.jp/~iryo/vba/IE/index01.html
ここにまとまって載ってます