書籍情報を検索するVBAを作成してみよう【楽天ブックス系API】

連載第13回目の目的

連載第13回では、前回の続きとしてExcel VBAにおける楽天ウェブサービスの活用について紹介します。前回で、APIの概要を紹介し、アプリケーションIDの取得やAPI呼び出しをテストしました。今回はワークシートを準備してスクリプトを作成し、サンプルを完成させます（図1）。

• 

  図1：完成サンプル

▼完成サンプルのExcelファイル
https://github.com/wateryinhare62/mynavi_excelvba_webservice

なお、本連載では動作確認をWindows 10 Pro（64bit）、Microsoft 365（Excel 16.0、VBA 7.1）で行っています。旧バージョンや単体のExcelで試す場合にはご注意ください。

ワークシートの準備

APIが使えることを確認できたら、ワークシートを用意し、基本的なデザインを行っていきましょう。配置および書き込むものは、以下のとおりです。

• アプリケーションのタイトルやコントロールのキャプション（説明は省略）
• 「書名」「著者名」「出版社名」テキストボックス
• 「ジャンル」「表示順」コンボボックス
• 「前のページ」「次のページ」「検索開始」ボタン
• 検索結果を収納する表
• クレジット表示

上記のテキストおよびコントロールを、図2を参考に書き込み、配置してください。具体的な手順は、第6回などを参考にしてください。

• 

  図2：ワークシートが準備された状態

コントロールを配置する

8つのコントロール（テキストボックス×3、コンボボックス×2、ボタン×3）をワークシート上部に配置して、プロパティを設定します。これらのプロパティの内容は、表1のとおりです。

▼表1：各コントロールに設定するプロパティ

コントロール

プロパティ

値

「書名」テキストボックス

Name

TitleTextBox

「著者名」テキストボックス

Name

AuthorTextBox

「出版社名」テキストボックス

Name

PublisherTextBox

「並び順」コンボボックス

Name

SortComboBox

Style

fmStyleDropDownList

「検索する」ボタン

Name

SearchCommandButton

「前のページ」ボタン

Name

PreviousCommandButton

「次のページ」ボタン

Name

NextCommandButton

検索結果を収納する表を作成する

表は、以下の構成とします。APIのデフォルトでは最大30個/ページが取得されるので、30個の検索結果が収納できるようにします。範囲の書式を「文字列」にしておくと、検索結果の書き込みで表示が乱れにくくなります。

• ISBN（ISBNコード）
• 書名（取得された書籍タイトル）
• 著者（取得された著者）
• 出版社（取得された出版社）
• 発売日（取得された発売日）
• サイズ（取得された判型、外形等）
• 税込み価格（取得された税込み価格）
• 説明（取得された商品説明）

クレジット表記を配置する

楽天グループ提供のWebサービスでは、クレジットの表記が義務付けられていますので、適当な形式で表記します。

▼楽天ウェブサービス: クレジット表示方法と注意 | ご利用ガイド
https://webservice.rakuten.co.jp/guide/credit

今回は、最もシンプルな「テキスト形式」を使用することにします。 ここで、ブックを保存しておきます。ブック名は何でもよいですが、VBAのスクリプトを実行できるようにするために、形式を「Excel マクロ有効ブック (*.xlsm)」にしてください。このあとも、適当なタイミングでブックを保存してください。

VBA-JSONを準備する

楽天ブックス系APIは、基本的に結果をJSONデータで返します。このようにVBAからJSONデータを使いますので、そのために必要なライブラリを準備します。第3回などと同様に、「VBA-JSON」を使用します。第3回の記事を参照して、「Microsoft Scripting Runtime」への参照設定を有効にすることを含めて、VBA-JSONを準備してください。

スクリプトを書いていく

ここから、Visual Basic Editorを使って、以下の順番でスクリプトを書いていきます。左ペインの「Microsoft Excel Objects」の「Sheet1 (Sheet1)」をダブルクリックして開くファイルに、以下のスクリプトを記述していきます。

• 定数、グローバル変数を定義するスクリプト
• グローバル変数を初期化するスクリプト
• APIにアクセスするスクリプト
• 並び順コンボボックスに項目リストを追加するスクリプト
• ジャンルコンボボックスに項目リストを追加するスクリプト
• ボタンクリックを処理するスクリプト
• 検索処理を実行しワークシートに反映するスクリプト

定数、グローバル変数を定義するスクリプト

エンドポイントURLやアプリケーションIDといった、アプリケーションの実行中に変化しない文字列は、定数として先頭部で定義しておきます。また、表示中のページなどの情報はプロシージャ間で共有するためにグローバル変数として定義しておきます。なお、定数の定義とは直接の関係はないですが、安全のために冒頭でOption Explicit文によって未定義の変数を使えないようにしています（リスト1）。AppIdには、おのおの取得したアプリケーションIDを設定してください。

［リスト1］定数、グローバル変数を定義

' 未定義の変数を使えないようにする
Option Explicit
' エンドポイントURLを定数で共有
Const EndPoint = "https://app.rakuten.co.jp/services/api/"
' アプリケーションIDを定数で共有
Const AppId = "1007…"
' 表示中のページ番号、総ページ数を保持
Dim CurrentPage As Integer, PageCount As Integer

グローバル変数を初期化するスクリプト

上記ではグローバル変数を2個定義しましたが、この初期化が必要です。初期化は、ワークシートのアクティブ時に行うことにします。エディタ上部の左側のプルダウンから「Worksheet」を選択し、右側のプルダウンから「Activate」を選択してください。自動的にイベントハンドラが作成されますので、リスト2のようにスクリプトを記述します。

［リスト2］グローバル変数を初期化するスクリプト

' ワークシートがアクティブになったときにグローバル変数を初期化する
Private Sub Worksheet_Activate()
    CurrentPage = 1
    PageCount = -1
End Sub

APIにアクセスするスクリプト

続けて、APIにアクセスするスクリプトを書いていきます。再利用を考慮して、APIへのアクセスは関数として独立させます。APIを呼び出すスクリプトは、KickWebServiceという関数にします。KickWebServiceは、引数にAPIのパスの一部とクエリパラメータを受け取って、結果としてのJSON文字列を返す関数です（リスト3）。

［リスト3］KickWebService関数

' APIを呼び出す（引数はAPIのパス、クエリパラメータ、戻り値はJSON文字列）
Private Function KickWebService(ByVal Path As String, ByVal Param As String)
    ' URLを作成する
    Dim Url As String
    Url = EndPoint & Path & "?" & Param & _
        "formatVersion=2&&applicationId=" & AppId       '(1)
    ' リクエストを送信する
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")   '(2)
    With http
        .Open "GET", Url, False    '(3)
        .send
        ' リクエスト結果を取得する
        KickWebService = .responseText  '(4)
    End With
End Function

変数Urlに、エンドポイント、パスの一部、クエリパラメータ、そしてアプリケーションIDをセットします（1）。HTTPアクセスに必要なMSXML2.XMLHTTPモジュールのオブジェクトを作成後（2）、HTTPメソッドとURLを指定してOpenメソッドを呼び出し、必要なリクエストパラメータを設定した後、sendメソッドで実際に呼び出します（3）。呼び出した結果はResponseTextプロパティで取得できます（4）。これが空なら何らかのエラーが発生していますが、これをそのまま関数の戻り値として返します。

並び順コンボボックスに項目リストを追加するスクリプト

並び順コンボボックス（SortComboBox）は、検索結果のソート順序を選択するためのものです。配置直後は項目リストは空ですので、ソート順序を項目リストとして設定しておきます。設定の方法にはいろいろありますが、ここではシンプルにコンボボックスがボタンでプルダウンされたときに設定することにします。ドロップボタンがクリックされたときに呼び出されるSortComboBox_DropButtonClickイベントハンドラを新たに作成します。ここにリスト4のようにスクリプトを追加してください。

［リスト4］SortComboBox_DropButtonClickイベントハンドラ

' 並び順コンボボックスクリックのイベントハンドラ
Private Sub SortComboBox_DropButtonClick()
    ' リストが未登録の場合のみ実行する
    If SortComboBox.ListCount = 0 Then  '(1)
        ' 項目リストをセットする
        With SortComboBox
            .AddItem "standard:標準"    '(2)
            .AddItem "sales:売れている"
            .AddItem "+releaseDate:発売日(古い)"
            .AddItem "-releaseDate:発売日(新しい)"
            .AddItem "+itemPrice:価格が安い"
            .AddItem "-itemPrice:価格が高い"
            .AddItem "reviewCount:レビューの件数が多い"
            .AddItem "reviewAverage:レビューの評価(平均)が高い"
        End With
    End If
End Sub

ドロップダウンは何回もクリックされるので、項目リストが重複しないように、（1）でリストが空かどうか判定し、空であるときのみ（2）で各項目を追加しています。

ジャンルコンボボックスに項目リストを追加するスクリプト

ジャンルコンボボックス（GenreComboBox）は、検索対象のジャンルを選択するためのものです。配置直後は項目リストは空ですので、ジャンルを項目リストとして設定しておきます。SortComboBoxと同様にプルダウンされたときに設定することにします。リスト5のようにイベントハンドラのスクリプトを追加してください。

［リスト5］GenreComboBox_DropButtonClickイベントハンドラ

' ジャンルコンボボックスクリックのイベントハンドラ
Private Sub GenreComboBox_DropButtonClick()
    ' リストが未登録の場合のみ実行する
    If GenreComboBox.ListCount = 0 Then     '(1)
        ' 項目リストをセットする
        Dim Param As String                 '(2)
        Param = "booksGenreId=001"
        Dim Result As String
        Result = KickWebService("BooksGenre/Search/20121128", Param)
        ' JSONデータが戻ってこない場合は処理を終了する
        If Left(Result, 1) <> "[" And Left(Result, 1) <> "{" Then   '(4)
            MsgBox "ジャンル取得結果不正"
            Exit Sub
        End If
        ' JSON文字列をディクショナリ形式に変換する
        Dim Json As Object
        Set Json = JsonConverter.ParseJson(Result)  '(5)
        ' errorキーが存在すれば処理を終了する
        If Json.Exists("error") = True Then
            MsgBox "ジャンル取得エラー：" & Json("error")
            Exit Sub
        End If
        ' childrenは配列なので要素数分繰り返す
        Dim i As Integer
        For i = 1 To Json("children").Count   '(6)
            GenreComboBox.AddItem _
                Json("children")(i)("booksGenreId") & ":" & _
                Json("children")(i)("booksGenreName")
        Next
    End If
End Sub

項目リストが重複しないように、（1）でリストが空かどうか判定し、空のときのみ（2）以降で各項目を追加しています。SortComboBoxと異なり、APIで設定内容を取得している点に注意してください。スクリプトの流れについては「検索処理を実行しワークシートに反映するスクリプト」と同様なので、そちらを参照してください。

ボタンクリックを処理するスクリプト

3つのボタンクリックに反応するスクリプトを書いていきます。3つのボタンは、いずれも検索を実行し、その結果でワークシートを更新するためのものです。ですので、検索そのものの処理は別のExecuteSearchプロシージャにまとめて、ここでのスクリプトは最低限必要な処理を記述するのみとします（リスト6）。

［リスト6］ボタンクリックを処理するスクリプト

' 検索ボタンを押したときの処理：現在ページを1にして検索を実行
Private Sub SearchCommandButton_Click()
    CurrentPage = 1
    ExecuteSearch
End Sub

' 前のページボタンを押したときの処理：可能な場合には現在ページを-1して検索を実行
Private Sub PreviousCommandButton_Click()
    If CurrentPage > 1 Then
        CurrentPage = CurrentPage - 1
        ExecuteSearch
    End If
End Sub

' 次のページボタンを押したときの処理：可能な場合には現在ページを+1して検索を実行
Private Sub NextCommandButton_Click()
    If CurrentPage < PageCount Then
        CurrentPage = CurrentPage + 1
        ExecuteSearch
    End If
End Sub

検索処理を実行しワークシートに反映するスクリプト

最後に、検索処理を実行しワークシートに反映するスクリプトを書いていきます。このスクリプトは、ボタンをクリックした際に呼び出されるイベントハンドラからさらに呼び出される下請けのプロシージャです（リスト7）。以下のような流れで、検索して結果をセルに書き込んでいます。

①書名、著者名、出版社名のテキストボックスに中身があれば、それらに基づきクエリパラメータを作成する
②書名、著者名、出版社名のいずれも指定がなければ検索処理を中止
③並び替え順序の指定があれば、それに基づきクエリパラメータを更新する
④ジャンルの指定があれば、それに基づきクエリパラメータを更新する
⑤クエリパラメータを指定してAPIを呼び出す
⑥結果がJSONか判定する
⑦JSONをディクショナリに変換する
⑧ディクショナリから必要な情報を取り出してセルに書き込む

［リスト7］検索処理を実行しワークシートに反映するスクリプト

' 検索を実行してワークシートに反映
Private Sub ExecuteSearch()
    Dim Param As String, Title As String, Author As String, Publisher As String
    ' 検索するタイトルを取得
    Title = TitleTextBox.Text     '(1)
    If Title <> "" Then
        Call AppendParam(Param, "title=" & WorksheetFunction.EncodeURL(Title))
    End If
    ' 検索する著者名を取得
    Author = AuthorTextBox.Text     '(2)
    If Author <> "" Then
        Call AppendParam(Param, "author=" & WorksheetFunction.EncodeURL(Author))
    End If
    ' 検索する出版社名を取得
    Publisher = PublisherTextBox.Text     '(3)
    If Publisher <> "" Then
        Call AppendParam(Param, _
            "publisherName=" & WorksheetFunction.EncodeURL(Publisher))
    End If
    ' 3つとも空なら検索を中止
    If Title = "" And Author = "" And Publisher = "" Then       '(4)
        MsgBox "書名か著者名か出版社名を指定してください"
        Exit Sub
    End If
    ' 並び替え順序を取得
    Dim Sort As String      '(5)
    Sort = SortComboBox.Text
    If Sort <> "" Then
        Sort = SplitFirst(Sort, ":")
        Call AppendParam(Param, "sort=" & WorksheetFunction.EncodeURL(Sort))
    End If
    ' ジャンルを取得
    Dim Genre As String     '(6)
    Genre = GenreComboBox.Text
    If Genre <> "" Then
        Genre = SplitFirst(Genre, ":")
        Call AppendParam(Param, "booksGenreId=" & Genre)
    End If
    ' 検索ページをクエリパラメータに追加
    Call AppendParam(Param, "page=" & CurrentPage)      '(7)
    ' APIを呼び出す
    Dim Result As String
    Result = KickWebService("BooksBook/Search/20170404", Param) '(8)
    ' JSONデータが戻ってこない場合は処理を終了する
    If Left(Result, 1) <> "[" And Left(Result, 1) <> "{" Then   '(9)
        MsgBox "書籍取得結果不正"
        Exit Sub
    End If
    ' JSON文字列をディクショナリ形式に変換する
    Dim Json As Object
    Set Json = JsonConverter.ParseJson(Result)  '(10)
    ' errorキーが存在すれば処理を終了する
    If Json.Exists("error") = True Then
        MsgBox "書籍検索エラー：" & Json("error")
        Exit Sub
    End If
    PageCount = Json("pageCount")       '(11)
    Cells(9, 1) = Json("page") & _
        "ページを表示しています（総ページ数" & PageCount & "）"
    Dim i As Integer, Row As Integer, Col As Integer
    Row = 13
    Col = 1
    ' itemsは配列なので要素数分繰り返す
    For i = 1 To Json("Items").Count   '(12)
        ' MsgBox Title & Author & Publisher
        Cells(Row, Col) = Json("Items")(i)("isbn")   '(13)
        Cells(Row, Col + 1) = Json("Items")(i)("title")
        Cells(Row, Col + 2) = Json("Items")(i)("author")
        Cells(Row, Col + 3) = Json("Items")(i)("publisherName")
        Cells(Row, Col + 4) = Json("Items")(i)("salesDate")
        Cells(Row, Col + 5) = Json("Items")(i)("size")
        Cells(Row, Col + 6) = Json("Items")(i)("itemPrice")
        Cells(Row, Col + 7) = Json("Items")(i)("itemCaption")
        Row = Row + 1
    Next
    ' 余剰のセルはクリアする
    If Json("Items").Count < 30 Then    '(14)
        Range(Cells(Row, Col), _
            Cells(Row + (30 - Json("Items").Count) - 1, Col + 7)) = ""
    End If
End Sub

（1）～（3）で、書名、著者名、出版社名からクエリパラメータを作成しています。それぞれ、内容をURLエンコードしています。URLエンコードには、第9回と同様にWorksheetFunctionオブジェクトのEncodeURL関数を使用しています。また、ここで使われているAppendParamはクエリパラメータの追加のための独自のプロシージャです（スクリプトの内容はサンプルを参照してください）。その後、（4）でどれかが指定されているかチェックし、指定がなければ検索を中止します。
（5）（6）では、並び替え順序とジャンルの指定があればクエリパラメータを更新しています。ここで使われているSplitFirstは、指定文字で文字列を分割し、最初の文字列を返す独自のプロシージャです。コンボボックスのリスト項目からクエリに必要な部分だけを切り出すために使用しています（スクリプトの内容はサンプルを参照してください）。
（7）で取得したいページをクエリパラメータに加えて、（8）でAPIを呼び出しています。有効なJSON文字列が返ってきていないと判断される場合には、エラーメッセージをセルに設定して終了させます（9）。有効ならば、VBA-JSONのParseJsonメソッドを使って、JSON文字列をディクショナリ形式のオブジェクトに変換します。errorキーが存在していれば何らかのエラーが発生していますので、ここでもエラーメッセージを表示して処理を終了させます（10）。
（11）では、表示中のページと総ページ数をセルに反映しています。（12）からは、Items配列の要素だけセルへの反映を繰り返します。検索結果が30件に満たない場合には、余剰のセルをすべてクリアします（14）。

これで、スクリプトの作成は終了です。ワークシートの形を整えて冒頭の図1のようになれば完成です。検索条件をいろいろ変えて試してみてください。

まとめ

前回と今回は、楽天ウェブサービスの楽天ブックス系APIを使った、書籍情報の検索を紹介しました。今回は、書籍検索に絞った例を紹介しましたが、別のAPIを使ったり組み合わせたりすることで、メディアやゲーム、ソフトウェアも検索できるものにするなど、活用の幅が拡がりそうだと感じていただけたのではないでしょうか。

WINGSプロジェクト 山内直著/山田祥寛監修
＜WINGSプロジェクトについて＞テクニカル執筆プロジェクト(代表山田祥寛)。海外記事の翻訳から、主にWeb開発分野の書籍・雑誌/Web記事の執筆、講演等を幅広く手がける。一緒に執筆をできる有志を募集中