WebクエリでGoogleの検索結果を取得する

Webクエリの作成方法については
記事『 Webクエリまとめ 』を参照してください。

GoogleのURLは「http://www.google.co.jp/」です。
これをWebクエリに使っても検索はできません。

オーソドックスな方法は、
Googleのページアクセスして
テキストボックスの中に検索したい文字列を入力して検索します。

GoogleはURLだけでも検索できるようになっています。

「http://www.google.co.jp/」につづけて
「search?q=」を加えます。

この後に検索したい文字列を続けたURL、
例えば
「http://www.google.co.jp/search?q=Excel VBA」を
WebブラウザにURLとして入力してアクセスすると、
「Excel VBA」で検索した場合の
最初の10件の検索結果が表示されます。

検索結果の2ページをあらわすURLは、
「http://www.google.co.jp/search?q=Excel VBA&start=10」

「&start=10」が加わりました。
実は最初のページは「&start=0」です。

つまり、
1件目から10件目までのページは「&start=0」
11件目から20件目までのページは「&start=10」
21件目から30件目までのページは「&start=30」
…

URL全体を見ます。

http://www.google.co.jp/search?q=Excel VBA&start=0
http://www.google.co.jp/search?q=Excel VBA&start=10
http://www.google.co.jp/search?q=Excel VBA&start=20

上から順に
「Excel VBA」で検索した場合の最初の10件のページ、
11件目から20件目までのページ、
21件目から30件目までのページになります。

このようなURLをWebクエリに使います。

「Google URL パラメータ」で検索すると
これらについて解説したページもあるようです。
細かく指定すれば
より精度の高い検索ができるかもしれません。

ここでは、
検索文字とページの2つのパラメータのみ使用します。

下のコードの大まかな流れを説明します。

まず、検索結果を入れるシートを挿入します。
基本のシート名は"検索結果"ですが、
同名のシートがある場合は番号を振っていきます。

次に、Webクエリ用のシートを挿入します。
名前は"Webクエリ"です。

このシートに、
"Google検索結果"という名前のWebクエリを作成して
検索結果の最初のページを取得します。

取得した検索結果から
ページへのリンクとサイトの説明を
"検索結果"シートにも入れます。
並び順から判断して順番も入れていきます。

余分な情報を避けるために、
If文を使って必要なデータと
そうでないデータをより分けています。

最初のページの結果を取得したら
次のページをWebクエリで取得します。
その際のURLは最初に述べた通りです。

WebクエリのURLだけを変更して
更新すると次のページが取り込めます。

次のページの結果を取得したら
最初のページと同様に
"検索結果"シートにデータを入れていきます。

目的の検索件数になるまで
これを繰り返します。

終了時に"Webクエリ"シートを削除します。

コードはこちら

Sub macro111022a()
'Googleの検索結果をWebクエリで取得
'URL2 = 検索したい文字列、複数はスペースで続ける
'Start2 = 取り出す結果の数

    Application.ScreenUpdating = False
   
    Dim i As Integer
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh2Row As Integer 'sh2の行を指定
    Dim URL0 As String
    Dim URL1 As String, URL2 As String, URL3 As String
    Dim Start As Integer
    Const Start2 As Integer = 100
    URL1 = "http://www.google.co.jp/search?q="
    URL2 = "excel vba"
    URL3 = "&start="
    Start = 0
   
    '検索結果を入れるシートを作成
    'シ ート名をナンバリング
    Set sh2 = Sheets.Add
    With sh2
        Dim obj As Object
        Dim shname As String
        Dim NameLen As Integer
        Dim num As Integer
        shname = "検索結果"
        NameLen = Len (shname)
        num = 1
Step050:
        For Each obj In Worksheets
            If obj.Name = shname Then
                shname = Left(shname, NameLen) & num
                num = num + 1
                GoTo Step050
            End If
        Next obj

        .Name = shname
        .Cells(1, 1) = "番号 "
        .Cells(1, 1).ColumnWidth = 4
        .Cells(1, 2) = "URL"
        .Cells(1, 2).ColumnWidth = 20
        .Cells(1, 3) = "説明"
    End With
   
    Set sh1 = Sheets.Add
    sh1.Name = "Webクエリ"
   
    'Webクエリ作 成
    'WebSelectionType = xlEntirePage
    URL0 = URL1 & URL2 & URL3 & Start
    With ActiveSheet.QueryTables.Add( _
        Connection:="URL;" & URL0, _
        Destination:=Range("A1"))
       
        .Name = "Google検索結果"
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .BackgroundQuery = False

        .Refresh
    End With
   
    'Webクエリからデー タを取得
    sh2Row = 2
   
Step100:
    '"Webクエリ"シートでテキトー に80行目から
    For i = 80 To ActiveSheet.UsedRange.Rows.Count
       
        If Cells(i, 1).Hyperlinks.Count > 0 Then
'        Cells(i, 1).Select
        'リンクがある場合
            If IsNumeric(Left(Cells(i, 1).Hyperlinks (1).TextToDisplay, 1)) _
                And InStr(Cells(i, 1).Hyperlinks(1).TextToDisplay, ". ") <> 0 Then
            '一文目が数値かつ、". "(コンマスペース)が含まれていれ ば有効なURLとみなす
                sh2.Cells(sh2Row, 1) = sh2Row - 1 '番号
                'URL
                sh2.Hyperlinks.Add Anchor:=sh2.Cells(sh2Row, 2), _
                    Address:=Cells(i, 1).Hyperlinks (1).Address, _
                    TextToDisplay:=Split(Cells(i, 1).Hyperlinks (1).TextToDisplay, ". ")(1)
                sh2.Cells(sh2Row, 3) = sh1.Cells(i + 1, 1)
                sh2Row = sh2Row + 1 '説明
            End If
        End If
       
        If InStr(Cells(i + 1, 1), "に関連する検索キーワード") <> 0 Then
        '"に関連する検索キーワード"が含まれているセルの 前で終了
        '次のページへ
            Exit For
        End If
       
    Next i
   
    '次のページに行くかどうか
    '100の検索結果を取得するようになっている
    If Start < Start2 Then
        Start = Start + 10
        URL0 = URL1 & URL2 & URL3 & Start
        With ActiveSheet.QueryTables("Google検索結果")
            .Connection = "URL;" & URL0
            .Refresh BackgroundQuery:=False
        End With
        GoTo Step100
    End If
   
    '終了処理
    '"Webクエリ"シート削除
    Application.DisplayAlerts = False
        sh1.Delete
    Application.DisplayAlerts = True
   
    Application.ScreenUpdating = True
End Sub

上のコードを実行したあとの結果の例：

ScreenUpdating = Falseにしてあるので、
上のコードを実行すると
検索結果のシートが突然できたように見えます。