Google Suggest の検索候補を取得する

Google の検索枠に文字を入力すると、↓のように検索キーワードの候補が表示されますが、これはGoogle サジェストという機能によって提供されています。

この機能は、Google Suggest API として一般に公開されているので手軽に利用できます。今回は、VBAでGoogle Suggest API のキーワード候補をA to Zで取得するループ文を組んでみます。

一旦、シート内のデータをクリアするので、作業中のブックでは実行しないように注意してください。

Option Explicit

Sub GoogleSuggest_Alphabet()

Dim xKeyword As Variant
Dim xURL As String
Dim i As Integer, j As Integer
Dim xRng As Range

' シート内のデータを一旦クリア '
ActiveSheet.Cells.Clear
' ウィンドウ枠固定の解除 '
ActiveWindow.FreezePanes = False

' a-zを配列に入れる '
xKeyword = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", _
    "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z")

' WebクエリでGoogleSuggestAPIからデータを取り込むループ文 '
For i = LBound(xKeyword) To UBound(xKeyword)

    xURL = "http://google.com/complete/search?output=toolbar&hl=ja&q=" & xKeyword(i)

    With ActiveSheet.QueryTables.Add(Connection:="URL;" & xURL, Destination:=Cells(i * 12 + 1, 1))
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .WebFormatting = xlWebFormattingNone
        .Refresh BackgroundQuery:=False
    End With

    ' GoogleSuggestAPIに渡したキーワードをソート用に付記 '
    For j = i * 12 + 1 To i * 12 + 12
        Cells(j, 4) = xKeyword(i)
    Next j
Next i

' 余分な行をカット '
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Set xRng = Range("A:A").Find(what:="/")
    If Not xRng Is Nothing Then xRng.EntireRow.Delete Shift:=xlUp
Next i

' 取得した結果を別の列にコピーして、クエリを削除 '
With ActiveSheet
    .Range("C:C").Copy Destination:=Range("E:E")
    .Range("A:A").Copy Destination:=Range("F:F")
    .Range("A:C").Delete
    ' タイトル行を挿入 '
    .Range("1:1").Insert
    .Cells(1, 1) = "#"
    .Cells(1, 2) = "suggestion data"
    .Cells(1, 3) = "num_queries"
    .Cells(2, 1).Select
End With

' ウィンドウ枠を固定 '
ActiveWindow.FreezePanes = True

' オートフィルタと列幅調整 '
With ActiveSheet
    .Cells(1, 1).AutoFilter
    .Range("A:A,C:C").EntireColumn.AutoFit
End With

End Sub