エクセルと書籍APIで、漫画本リスト作成自動化

大量の漫画本を発見

 今年、なんとか大学受験を終えた息子が整理を始めました。納戸に漫画本がたくさんあるのは知っていましたが、いざ息子の部屋に運び入れ、山積みされた漫画本を見て愕然としました。受験期間中にも相当量の漫画本を購入していた様です。今さら言っても仕方ありませんが、もっとしっかり勉強して欲しかった。
 下の写真が山積状態の漫画本です。カラーボックスには奥と手前に収納されています。
 その息子から「あまりにたくさんの漫画本があるので、どこにあるのか分からなくなる。漫画本リストを作りたい。」という相談を受けました。親として漫画・スマホ・ゲームを憎む私としては、決して快いことではありませんが、効率的に管理する視点は必要です。また漫画本管理に無駄な時間を使って欲しくないのでリスト作成効率化に協力することにしました。

ISBN番号

 ISBN(International Standard Book Number )は、書籍類の識別用に設定された国際規格コードとのことです。通常、下図の様に本の背面に、番号とバーコード表記されています。今回、テストした本の中にはバーコードが無いものもありました。
 日本の場合は「9784」で始まります。

書籍API について

 いろいろ調べていると「書籍API」というものがあることを知りました。(下表)  書籍APIを使って、ISBN番号から題名・著者・出版日等の情報を取得できます。
 幾つかある書籍APIの中から「openBD」を使うことにしました。どれが良いということではありませんが、下表①②は登録が必要なので対象外としました。次に④Google Books APIs を使用し、エクセルVBAプログラムを作成しました。幾つかの私の書籍でテストし、ほとんど検索出来たのですが、実際に息子の漫画本を持ってきてテストするとほぼ全滅です。一方、⑤openBD は漫画本だけでなく、④Google Books APIs で検索出来なかった私の本のデータも取得することが出来ました。
 ③国立国会図書館サーチの検索用API については、データ形式が、“xml” で最初に作成した “json” 対応プログラムを流用しにくいなどの理由で深く確認はしていません。

【主な書籍API】      
No 書籍API 登録 データ 採用
Amazon Product Advertising API
楽天ブックス書籍検索API
国立国会図書館サーチの検索用API 不要 xml
Google Books APIs 不要 json
openBD 不要 json


 次に書籍APIの使い方についてです。先ず、下表に書籍APIへの接続URLを記載します。

【書籍APIの接続URL】
   {isbn}
:ISBN番号,{appID}:登録ID(楽天ブックス)
No 書籍API接続URL
楽天ブックス書籍検索API
https://app.rakuten.co.jp/services/api/BooksTotal/Search/20170404?format=json&isbnjan={isbn}&applicationId={appID}
国立国会図書館サーチの検索用API
http://iss.ndl.go.jp/api/sru?operation=searchRetrieve&query=isbn={isbn}
Google Books APIs
https://www.googleapis.com/books/v1/volumes?q=isbn:{isbn}
openBD
https://api.openbd.jp/v1/get?isbn={isbn}


 Google Books APIsの接続URL内の ISBN番号({isbn})に検索したい書籍のISBN番号を設定し、GoogleChromeでURL入力すると 次の図の様に表示されます。赤くマークした箇所をみるとタイトル・著者・出版日等の情報があります。
 書籍 ISBN番号を読み取り、エクセルVBAプログラムを使って、書籍APIの接続URLにISBN番号を
設定、HTTPリクエスト、返信結果受信・解析出来れば、リスト作成を自動化できそうです。

エクセルVBAでHTTPリクエスト

 エクセルVBAでのHTTPリクエスト方法について説明します。

①参照設定(Microsoft XML, v6.0)
 エクセルVBEを開いて、メニューから「ツール」→「参照設定」を開きます。「参照設定」ダイアログが開いたら「Microsoft XML, v6.0」にチェックを入れて“OK”します。

②HTTPリクエスト関数(VBA)
 次の関数を ISBN番号を指定して呼ぶとサーバーからのレスポンスを受け取ることができます。(openBD

Private Function HTTP_REQ(isbn_no)   
    Dim httpReturn
    Dim http_url
    Dim httpReq As XMLHTTP60
    http_url = "https://api.openbd.jp/v1/get?isbn=" & isbn_no
    
On Error GoTo Err_Handling   
    Set httpReq = New XMLHTTP60
    httpReq.Open "GET", http_url
    httpReq.Send
 
    Do While httpReq.readyState < 4
        DoEvents
    Loop
 
    httpReturn = httpReq.responseText
    Set httpReq = Nothing
    HTTP_REQ = httpReturn
    Exit Function
 
Err_Handling:
    Set httpReq = Nothing
    HTTP_REQ = "ERR"
End Function
JSON形式データ解析

 次に受信したJSON形式データの解析です。
 JSONとは次の様なものです。

JavaScript Object Notation(JSON、ジェイソン)は軽量なデータ記述言語の1つである。構文はJavaScriptにおけるオブジェクトの表記法をベースとしているが、JSONはJavaScript専用のデータ形式では決してなく、様々なソフトウェアやプログラミング言語間におけるデータの受け渡しに使えるよう設計されている。
フリー百科事典『ウィキペディア(Wikipedia)』より


 何となく雰囲気は理解しましたが、厳密には判りません。所詮息子の漫画本管理用なので、ここでは労力をかけずに単なるテキストデータを受信したものとして処理します。
 下記は “openBD” にHTTPリクエストし、受信したデータです。最後の “summary” 以降(赤色部)の部分に入手したい情報が集約されている様です。
 “summary” 以降の部分を抜き出しました。今回、欲しい情報は、”title”(題名),”author”(作者),”pubdate”(出版日)程度です。つまり、 “summary”: { 欲しい情報群
となっています。
 文字列関数 ( InStr等 ) を使って、“summary”の位置を検出し、更にこの位置より後にある最初の “ { ” , “ } ” の間にある文字列が 欲しい情報群 です。この中の “title”“pubdate”“author” に対応する文字列を取得します。

“summary”: {“isbn”: “9784774175942”, “title”: “C#6実践的プログラミング〈入門〉講座”, “volume”: “”, “series”: “”, “publisher”: “技術評論社”, “pubdate”: “2015-09”, “cover”: “https://cover.openbd.jp/9784774175942.jpg”, “author”: “川俣晶/著” } }]

 

エクセルVBAによるリスト作成

 下の図が今回作成したエクセルVBAプログラムです。エクセルシートの上側にあるテキストボックスに13桁のISBN番号を入力するとTextBoxチェンジイベントで自動的に処理を開始します。処理が終わると図の水色部に検索結果を表示し、同時に10行目以降のリスト部分の最下行に結果を追加します。

バーコードリーダーによる連続処理

 今回作成したエクセルVBAプログラムはバーコードリーダーを用いた連続処理に対応しています。従って、パソコンに直接ISBN番号を入力する必要はありません。bluetooth等の無線バーコードリーダーを使えば少し離れたところから、結果を確認し連続的にバーコードを読み込んでリストを追加していきます。

VBAプログラム

 全体プログラムは次の通りです。エクセルシート上にコマンドボタンとテキストボックスを配置します。

Option Explicit

'ボタンクリックで処理を開始する
Private Sub CommandButton1_Click()

    Dim isbn_no

    isbn_no = Trim(TextBox1.Text)   'ISBN番号
    
    If Len(isbn_no) = 13 Or Len(isbn_no) = 10 Then
        chk_isbn_info (isbn_no)
    Else
        MsgBox "ISBN番号のは、10桁 または 13桁です。", vbOKOnly + vbCritical
    End If


End Sub

'シート内のテキスト文字数によって処理を開始する
Private Sub TextBox1_Change()

    Dim isbn_no

    isbn_no = Trim(TextBox1.Text)   'ISBN番号
    
    If Len(isbn_no) = 13 Then
        chk_isbn_info (isbn_no)
    End If

End Sub


'ISBN検索処理と結果分析
Private Sub chk_isbn_info(isbn_no)

    Dim sht
    Dim book_info
    
    sht = ActiveSheet.Name          'シート名
    
    Worksheets(sht).Range(Cells(6, 1), Cells(6, 5)).Interior.ColorIndex = xlNone
    Worksheets(sht).Range(Cells(6, 1), Cells(6, 5)).Value = ""

    
    book_info = HTTP_REQ(isbn_no, 1, sht)
    
    If book_info = "[null]" Then
        'HTTP通信エラー
        Worksheets(sht).Cells(6, 1).Value = "データ無!"
        Worksheets(sht).Range(Cells(6, 1), Cells(6, 5)).Interior.ColorIndex = 6
        MsgBox "[null]が返信されました。", vbOKOnly + vbCritical
    
    ElseIf book_info <> "ERR" Then
        Call JSON_analyzer_api_openbd(book_info, isbn_no, sht)
        'Call JSON_analyzer_simple(book_info, isbn_no, sht) 'Google Books APIs
    
    Else
        'HTTP通信エラー
        Worksheets(sht).Cells(6, 1).Value = "HTTPエラー!"
        Worksheets(sht).Range(Cells(6, 1), Cells(6, 5)).Interior.ColorIndex = 3
        MsgBox "HTTPリクエストに失敗しました。", vbOKOnly + vbCritical
    
    End If
    
    With ActiveSheet.TextBox1
        .SelStart = 0
        .SelLength = Len(TextBox1)
    End With

End Sub



Private Sub JSON_analyzer_api_openbd(jsn_inf, isbn_no, sht)
    Dim chr_cnt
    Dim kgr_cnt
    Dim tmp_chr
    Dim max_row
    Dim ii  ', jj
    Dim jsn_summary

    Dim s_chr(3)
    
    
    s_chr(0) = "summary"        'アイテム数
    s_chr(1) = "title"          '題名
    s_chr(2) = "author"         '作者
    s_chr(3) = "pubdate"        '出版日
    
    
    '最終行番号取得
    max_row = Worksheets(sht).Range("B9").End(xlDown).Row
    If max_row > 10000 Then max_row = 9

    chr_cnt = InStr(jsn_inf, s_chr(0))
    jsn_summary = Right(jsn_inf, Len(jsn_inf) - chr_cnt - 6)
    
    
    '対象項目を検索するループ
    For ii = 1 To 3
        chr_cnt = InStr(jsn_summary, s_chr(ii))
        
        If chr_cnt > 0 Then
            kgr_cnt = InStr(chr_cnt, jsn_summary, ",")
        
            If kgr_cnt = 0 Then
                kgr_cnt = InStr(chr_cnt, jsn_summary, "}")
            End If
                
            tmp_chr = Mid(jsn_summary, chr_cnt, kgr_cnt - chr_cnt)
            tmp_chr = Trim(Replace(Replace(Replace(Replace(Replace(Replace(tmp_chr, s_chr(ii), ""), """", ""), ":", ""), "[", ""), "]", ""), Chr(10), ""))
                
            If ii = 0 Then
                If tmp_chr = "0" Then
                    Worksheets(sht).Cells(6, 1).Value = "データ無!"
                    Worksheets(sht).Range(Cells(6, 1), Cells(6, 5)).Interior.ColorIndex = 6
                    MsgBox "対象データを確認出来ませんでした。", vbOKOnly + vbCritical
                    Exit Sub
                End If
            Else
                If ii = 1 Then
                    Worksheets(sht).Cells(max_row + 1, 1).Value = max_row - 8
                    Worksheets(sht).Cells(max_row + 1, 2).Value = isbn_no
                End If
                 
                Worksheets(sht).Cells(max_row + 1, 2 + ii).Value = tmp_chr
            
            End If
            
        End If
    Next
    
    Worksheets(sht).Cells(6, 1).Value = "成功!"
    Worksheets(sht).Cells(6, 3).Value = Worksheets(sht).Cells(max_row + 1, 3).Value
    Worksheets(sht).Range(Cells(6, 1), Cells(6, 5)).Interior.ColorIndex = 28
    
    Worksheets(sht).Range(Cells(10, 1), Cells(max_row, 5)).Interior.ColorIndex = xlNone
    Worksheets(sht).Range(Cells(max_row + 1, 1), Cells(max_row + 1, 5)).Interior.ColorIndex = 28
    
    Application.Goto Cells(max_row + 2, 1), True
    ActiveWindow.LargeScroll Down:=-1
  
    
End Sub




'ISBN番号から、HTTPリクエストし、関連情報(JSON形式)取得
'【例】https://www.googleapis.com/books/v1/volumes?q=isbn:9784798046266
Private Function HTTP_REQ(isbn_no, kbn, sht)
    
    Dim httpReturn
    Dim http_url
    Dim tmp
 
    Dim httpReq As XMLHTTP60
    
On Error GoTo Err_Handling
    
    Set httpReq = New XMLHTTP60
    
    If kbn = 0 Then
        'Google Books APIs
        http_url = "https://www.googleapis.com/books/v1/volumes?q=isbn:" & isbn_no
    Else
        'openBD
        http_url = "https://api.openbd.jp/v1/get?isbn=" & isbn_no
    End If
    
    Worksheets(sht).Cells(7, 1).Value = http_url

    httpReq.Open "GET", http_url
    httpReq.Send
 
    Do While httpReq.readyState < 4
        DoEvents
    Loop
 
    httpReturn = httpReq.responseText
 
    Set httpReq = Nothing
    
    HTTP_REQ = httpReturn
    
    Exit Function
 
Err_Handling:

    
    Set httpReq = Nothing
    HTTP_REQ = "ERR"
 
End Function
まとめ

 息子の要望は満たせた様です。