検索条件から検索結果を表示するVBAを記述する

コンボボックスに設定するデータは毎回クリアされますので、Excelを開いた時に自動実行させます。 [Alt]+[F11]キーでVBエディタを開き、左ペインで［ThisWorkbook］をダブルクリックし、コードウィンドウの上部で、［Workbook］、［Open］を選択します。「Private Sub Workbook_Open()」の中にコンボボックスへ選択肢を設定するVBAを以下のように記述します。

［リスト1］コンボボックスへ選択肢を設定する

Private Sub Workbook_Open()
    Sheets("Sheet1").cbOrder.list = _
        Array("関連度", "アップロード日", "再生回数", "評価")
End Sub

コードの記述が終わったら、[F5]キーを押して選択肢を設定しておきます。

次に、動画を検索して結果を表示する根幹の部分をコーディングします。 今回は、サーバーとの通信を担う「XMLHTTP」と、取得したXML文書を操るオブジェクトを利用するため、VBエディタのメニューバーから［ツール］－［参照設定］をクリックし、「Microsoft XML, v3.0」を追加します（図5）。

図5．「Microsoft XML, v3.0」参照設定の追加

参照設定が終わったら、VBエディタの左ペインで［Sheet1］をダブルクリックし、コードウィンドウ上で、以下のコードを入力します。

［リスト2］動画を検索して結果を表示する

Private Type result '検索結果を格納する構造型変数の定義
    title As String
    content As String
    published As Date
    link As String
    author As String
End Type

Sub searchMovie(ByVal start As Integer)

    'XMLHTTP通信に関する変数
    Dim url As String
    Dim order As String
    Dim js As Object

    '取得したXML文書を扱う変数
    Dim xmldata As MSXML2.DOMDocument
    Dim feed As MSXML2.IXMLDOMElement
    Dim entryList As MSXML2.IXMLDOMNodeList
    Dim entry As MSXML2.IXMLDOMNode
    Dim linkList As MSXML2.IXMLDOMNodeList

    '検索結果リストを格納する配列
    Dim resultList() As result

    Sheets("Sheet1").Activate

    '(1)キーワードの入力チェック
    If Len(Range("keyword")) = 0 Then
        MsgBox "キーワードが未入力です", vbExclamation
        Exit Sub
    End If

    '(2)URLエンコード関数を利用するため、JScript言語の使用準備
    Set js = CreateObject("ScriptControl")
    js.Language = "JScript"

    '(3)表示順コンボボックスで選択された値に従った表示順パラメーターのセット
    Select Case cbOrder.Value
        Case "関連度": order = "relevance"
        Case "アップロード日": order = "published"
        Case "再生回数": order = "viewCount"
        Case "評価": order = "rating"
    End Select

    '(4)検索キーワードにURLエンコード置換を施し、
    '表示順､開始番号を指定して､URLを組み立てる
    url = "http://gdata.youtube.com/feeds/api/videos" _
        & "?vq=" & js.CodeObject.encodeURIComponent(Range("keyword")) _
        & "&orderby=" & order _
        & "&start-index=" & start

    '(5)XMLHTTPを生成し、リクエストを送信（同期モード）
    Dim xmlhttp As New MSXML2.xmlhttp 'XMLHTTPオブジェクトを生成し、変数に格納
    xmlhttp.Open "GET", url, False '同期モードで接続
    xmlhttp.send 'リクエストを送信
    If xmlhttp.statusText <> "OK" Then
        MsgBox "失敗しました", vbCritical
        Exit Sub
    End If

    '(6)HTTPレスポンスをXML文書として変数に格納し、オブジェクトを解放
    Set xmldata = New MSXML2.DOMDocument
    xmldata.LoadXML xmlhttp.responseText
    Set xmlhttp = Nothing 'XMLHTTPオブジェクトを解放

    '(7)XML文書のfeed要素にアクセス
    Set feed = xmldata.DocumentElement

    '(8)feed要素の検索結果の数量データをワークシートのセルに転記
    Range("total") = feed.SelectSingleNode("openSearch:totalResults").Text
    Range("start") = feed.SelectSingleNode("openSearch:startIndex").Text
    Range("items") = feed.SelectSingleNode("openSearch:itemsPerPage").Text

    '(9)数量データに応じ、「次の25件」「前の25件」の利用可否を設定
    cbPrev.Enabled = (Range("start") > 1)
    cbNext.Enabled = (Range("start") + Range("items") <= Range("total"))

    '(10)検索結果を「entry」要素のリストとして取得し、一旦配列変数に格納
    Set entryList = feed.getElementsByTagName("entry")
    ReDim resultList(entryList.Length - 1)
    For i = 0 To entryList.Length - 1
        Set entry = entryList(i)
        With resultList(i)
            .title = entry.SelectSingleNode("title").Text
            .content = entry.SelectSingleNode("content").Text
            .published = timeConv(entry.SelectSingleNode("published").Text) '日時変換
            Set linkList = entry.SelectNodes("link")
            For j = 0 To linkList.Length - 1
                If linkList(j).Attributes.getNamedItem("rel").Text = "alternate" Then
                    .link = linkList(j).Attributes.getNamedItem("href").Text
                     Exit For
                End If
            Next
            .author = entry.SelectSingleNode("author").SelectSingleNode("name").Text
        End With
    Next
    Set xmldata = Nothing 'XMLオブジェクトを解放

    '(11)配列変数から、ワークシート上の結果リスト表示エリアに転記
    Range("list").Clear
    For i = 0 To UBound(resultList)
        ActiveSheet.Hyperlinks.Add _
            anchor:=Range("list").Cells(i + 1, 1), _
            Address:=resultList(i).link, _
            TextToDisplay:=resultList(i).title
        Range("list").Cells(i + 1, 2).Value = resultList(i).published
        Range("list").Cells(i + 1, 3).Value = resultList(i).author
        Range("list").Cells(i + 1, 4).Value = resultList(i).content
    Next

End Sub

Private Function timeConv(rfc3339 As String) As Date

    'RFC3339で既定された日時形式を変換
    （スクリプト省略）
    '日付と時刻を加え、時差を減じ、日本の時差を加える

End Function

冒頭のresultは、検索結果用の構造型を定義しています。 searchMovieプロシージャが3つのボタン［検索する］［次の25件］［前の25件］をクリックした際に共通に呼ばれる本体になります。ボタンにより開始番号が異なりますので、start引数を定義しています。

(1)でキーワードが入力されているかチェックしています。
(2)でURLエンコード関数を利用するため、JScript言語の使用準備をしています。URLエンコードについては、後述の(4)とともに、前回の記事を参照してください。
(3)では、選択された表示順に従って、order変数に値を設定しています。
(4)では、検索キーワードにURLエンコード置換を施し、表示順､開始番号を指定して､URLを組み立てています。

(5)ではXMLHTTPを生成し、リクエストを送信しています。XMMLHTTPを用いたサーバーとの通信についは、前回の記事を参照してください。
(6)では、HTTPレスポンス（受信データ）をXML文書として格納しています。
(7)では、オブジェクト変数feedに、そのルート要素（最上位の要素）を取り込んでいます。

(8)では、ルート要素（feed）の子要素にタグ名でアクセスし、検索した動画の総件数、取得開始順位、取得件数をワークシートに転記しています。
(9)では、取得開始順位が1以下の場合「前の25件」、取得開始順位＋取得件数が総件数を超えたら「次の25件」、それぞれのボタンを無効化（グレーアウト）させています（図6参照）。

図6．「前の25件」「次の25件」ボタンを無効にする判断

(10)では、動画の検索結果（<entry>要素の集合）をentryListオブジェクトに読み込み、1件ずつオブジェクト変数entryに格納しています。<entry>要素の配下から要素名をキーにして個別の情報（タイトル、説明、日時、リンク、著者）を取り出し、順番に配列resultListに格納しています。ただし、日時については、timeConv関数で「2011-02-08T12:40:00.000Z」の形式の文字列を解析し、日本標準時に変換した上で格納しています。また、リンクについては、rel属性がalternateのリンクのみ、そのhref属性を取り出しています。
(11)では、ワークシート上の結果リスト表示エリアを一旦クリアした上で、検索できた件数だけ、情報を転記しています。 1列目には、Hyperlinks.Add（表5参照）を利用して、リンク付きのタイトルを設定し、タイトルをリンクすることにより、起動するブラウザで動画が再生できるようにしています。

表5．HyperlinksコレクションのAddメソッドの主な引数

引数名 引数値
anchor ハイパーリンクを設定するセルまたはボタンなど
Address リンク先のアドレス（URLまたはファイルのパス）
ScreenTip マウスオーバー時のヒント文字列
TextToDisplay セル上に表示する文字列