検索するための部品を作成する

検索条件として「書籍タイトル」、「著者名」、「出版社名」、「ISBNコード」を指定するためのセルを用意します。入力セルにはそれぞれ、「title」、「author」、「publish」、「isbn」という名前を定義しておいてください。

また、検索ボタンを作るため、［開発］タブの［挿入］ボタンをクリックし、［ActiveXコントロール］の［コマンドボタン］をクリックし、配置します。名前は、「cbSearch」に変更しておきます。また、コマンドボタンを右クリック－［コマンド ボタン オブジェクト］－［編集］をクリックすると、ボタン表示部分にカーソルが現れますので、「検索」に変更しておきます。

図7．条件入力セルと検索ボタン

図7のような準備ができればOKです。

検索条件から検索結果を表示するVBAを実装する

ボタンの選択を解除し、［開発］タブの［デザインモード］をONの状態にして、コマンドボタンをダブルクリックすると、VBエディタが開きます。 この中に記述したコードが、コマンドボタン「cbSearch」をクリックしたときに実行されますので、プロシージャの名称「Private Sub cbSearch_Click()」は変えないでください。

本VBAでは、Webサーバーとの通信を操る「XMLHTTP」オブジェクトを利用するため、VBエディタのメニューバーから［ツール］－［参照設定］をクリックし、「Microsoft XML, v3.0」を追加します（図8）。

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

参照設定が終わったら、プロシージャ「Private Sub cbSearch_Click()」内に以下のコードを記述します。

［リスト1］検索条件にヒットした書籍データを取り込む

Private Sub cbSearch_Click()

    '(1)デベロッパーIDの設定
    Const devID As String = "【デベロッパーID】"

    '(2)検索条件入力チェック
    If Len(Range("title")) + Len(Range("author")) + Len(Range("publish")) + Len(Range("isbn")) = 0 Then
        MsgBox "検索条件が設定されていません。", vbExclamation
        Exit Sub
    End If

    '(3)URLの固定部分の設定
    Dim url As String
    url = "http://api.rakuten.co.jp/rws/3.0/rest?developerId=" & devID _
    & "&operation=BooksBookSearch&version=2011-01-27"        
    '(4)URLエンコード関数を利用するための、JScriptの設定
    Dim JS As Object
    Set JS = CreateObject("ScriptControl")
    JS.Language = "JScript"

    '(5)検索条件をURLエンコードして、URLに追加する部分
    If Len(Range("title")) > 0 Then _
        url = url & "&title=" & JS.CodeObject.encodeURIComponent(Range("title"))
    If Len(Range("author")) > 0 Then _
        url = url & "&author=" & JS.CodeObject.encodeURIComponent(Range("author"))
    If Len(Range("publish")) > 0 Then _
        url = url & "&publisherName=" & JS.CodeObject.encodeURIComponent(Range("publish"))
    If Len(Range("isbn")) > 0 Then _
        url = url & "&isbn=" & (Range("isbn"))

    '(6)検索条件を追加したURLで検索結果を取得する
    Dim xmlhttp As New MSXML2.xmlhttp ' a. オブジェクトの生成と代入
    Dim res_txt As String
    xmlhttp.Open "GET", url, False ' b.GETメソッド、同期通信で接続
    xmlhttp.send ' c.リクエストを送信
    If xmlhttp.statusText <> "OK" Then ' d. 通信に失敗したときは終了
        MsgBox "通信に失敗しました（ステータス：" & xmlhttp.statusText & "）", vbCritical
        Exit Sub
    End If
    res_txt = xmlhttp.responseText ' e. データを格納
    '（7）データをワークシート上のテーブルに上書き
    ActiveWorkbook.XmlMaps("Response_対応付け").ImportXml xmldata:=res_txt, overwrite:=True
    Set xmlhttp = Nothing ' f.オブジェクトの解放

End Sub

(1)デベロッパーIDを定数として宣言します。
(2)条件入力セルの文字数を合計して0ならば、どの条件も未入力と判断して、警告メッセージとともに処理を終了します。
(3)楽天Webサービスの書籍検索にアクセスするためのURLの固定部分を設定します。

(4)検索値に日本語が含まれる場合「URLエンコード」置換（後述の「関連知識」参照）を行う必要があります。このためJScript言語の関数を借用するための準備をします。実際に検索を行っているのは（5）の部分です。検索値が存在する場合、引数値をJScriptのencodeURIComponent関数によりURLエンコード変換を行い、引数名に設定してURLに追加します。

(6)では、XMLHTTPオブジェクト（後述の「関連知識」参照）を用いて、Webサーバーとの通信を行っています。取得した受信データは、あらかじめ作成しておいた対応ルール"Response_対応付け"に関連付けます（（7））。xmldataパラメータは受信データ、overwriteパラメータは、既存のデータに上書きするかどうかを表します（Trueで上書き）。

以上で、完成です。VBエディタを閉じ、［開発］タブの［デザインモード］をOFFの状態にし、検索条件を入力し、「検索」ボタンをクリックして、検索データが表示されれば成功です（完全なコードは、ここ(sample.lzh)からダウンロードしてください）。