国立国会図書館のAPIを利用し、VBAで書誌情報を取得する

１．マクロの説明

ISBNをもとに、書誌情報（タイトル、請求記号など）を取得します。以前私がpythonで作成したプログラムをVBAに置き換え、少々改変したものになります。

APIの利用規約は必ずお読み頂いた上で、この記事をお読みください。

【注意】国立国会図書館のAPIを利用させて頂く立場なのでそちらに過度な負荷をかけるようなアクセスは行わないように２秒間の間隔を設けています。

マクロの実行例

マクロを実行すると以下のように国立国会図書館の書誌データを取得できます。

マクロ実行前

マクロ実行後

２．使い方

【注意】国立国会図書館のAPIを利用させて頂く立場なのでそちらに過度な負荷をかけるようなアクセスは行わないようにご注意ください。

エクセルを立ち上げ、「書誌情報の取得」というシート名のシートを作成します。

下記の順番（見づらいです…すみません）で５行目に列名を次のような順番で入力します。
１～４行は気にしないでください。

※空欄 ISBN タイトル タイトルカナ 請求記号 シリーズタイトル シリーズタイトルカナ 著者 作者 作者カナ 出版社 出版年 出版年月 出版国 価格 総ページ数 備考 説明 種類

ISBNの列(B列)は表示書式をテキストに設定するのが良いと思います。

空欄の(A列)はバーコード番号などを想定しています。マクロで自動取得するデータとは関係がありません。

開発タブがない場合
ファイル　→　オプション　→　リボンのユーザー設定　→　開発にチェック

マクロを作成
開発タブ　→　VisualBasic →　画面の左を右クリック → 挿入　→　標準モジュールの作成

画面の右側にコードを貼り付ける　→　保存
※貼り付け用のコードは最後に紹介します

エクセルに戻り　開発　→　挿入　→　ボタン

範囲を指定して、セル上にボタンを作成

ボタンを押した時に動かすマクロ（いま作った「書誌情報の取得処理」）を設定

ボタンを押して実行

エクセル保存時にマクロ有効ブックとして保存します。

余談 別のシートで請求記号を取得

ちなみに、請求記号は「361.3」と記載されています。以下は書名のカナ表記（全角）から「361.3 ｴ」のような請求記号を生成する例になります。

ASKでK6のカナ表記全角を半角に変換し、LEFT関数で最初の2字を取得します。
※国立国会図書館のデータでは、最初の文字が半角スペースになっているようです。
「361.3」と「ｴ」を合わせて請求記号を生成します。

=書誌情報の取得!E6&" "&LEFT(ASC(K6),2)

３．全コード（参考）

適宜変更してお使いください。

なお、しつこいようですが国立国会図書館のAPIを利用させて頂く立場なのでそちらに過度な負荷をかけるようなアクセスは行わないようにご注意ください。

書誌情報の取得

' ------------------------------------------
' 関数：RemoveHTMLTags
' 概要：文字列からHTMLタグを正規表現で除去します。
' 引数：inputText - HTMLタグを含む可能性のある文字列
' 戻り値：HTMLタグを除去した文字列
' ------------------------------------------
Function RemoveHTMLTags(ByVal inputText As String) As String
    Dim regEx As Object
    Dim result As String

    ' 正規表現オブジェクトの生成
    Set regEx = CreateObject("VBScript.RegExp")
    
    ' 正規表現の設定：タグに一致するパターンを指定します
    regEx.IgnoreCase = True
    regEx.Global = True
    regEx.Pattern = "<.*?>"
    
    ' 入力文字列からHTMLタグを除去
    result = regEx.Replace(inputText, "")
    
    ' 結果を返却
    RemoveHTMLTags = result
End Function


' ------------------------------------------
' サブプロシージャ：書誌情報の取得処理
' 概要：指定されたシートのISBNをもとに、NDLのAPIから書誌情報を取得し、Excelに自動入力します。
' 対象シート：ThisWorkbook.Sheets("書誌情報の取得")
' 処理対象行：6行目から106行目まで（必要に応じて調整可能）
' ------------------------------------------
Sub 書誌情報の取得処理()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("書誌情報の取得")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim i As Long
    For i = 6 To 106 ' 必要に応じて変更
        Dim isbn As String
        isbn = ws.Cells(i, 2).Value
        
        If isbn <> "" Then
            Dim url As String
            url = "https://ndlsearch.ndl.go.jp/api/opensearch?isbn=" & isbn
            
            ' HTTPリクエストの作成
            Dim xhr As Object
            Set xhr = CreateObject("MSXML2.XMLHTTP")
            
            ' アクセス過多を防ぐため、2秒間の待機を設けます
            Application.Wait Now + TimeValue("00:00:02")
            
            xhr.Open "GET", url, False
            xhr.Send
            
            ' ステータスコードを確認（200番台以外はエラー）
            If xhr.Status <> 200 Then
                MsgBox "HTTPエラー: " & xhr.Status & "（ISBN: " & isbn & "）"
                GoTo NextISBN
            End If
            
            ' 取得したレスポンスを文字列として格納
            Dim response As String
            response = xhr.responseText
            
            ' XMLパーサーの生成と読み込み
            Dim xmlDoc As Object
            Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
            
            If Not xmlDoc.LoadXML(response) Then
                MsgBox "XMLパースエラー: " & xmlDoc.parseError.reason & "（ISBN: " & isbn & "）"
                GoTo NextISBN
            End If
            
            ' itemノードの取得
            Dim item As Object
            Set item = xmlDoc.SelectSingleNode("//item")
            
            If Not item Is Nothing Then
                ' 各変数の初期化
                Dim d_title As String, d_description As String, d_author As String
                Dim d_category1 As String, d_category2 As String, d_dctitle As String
                Dim d_dcndl_titleTranscription As String, d_dc_creator As String
                Dim d_dcndl_creatorTranscription As String, d_dcndl_seriesTitle As String
                Dim d_dcndl_seriesTitleTranscription As String, d_dc_publisher As String
                Dim d_dcndl_publicationPlace As String, d_dc_date As String
                Dim d_dcterms_issued As String, d_dcndl_price As String
                Dim d_dc_extent As String, d_dc_subject As String, d_dc_description As String

                ' 各要素が存在する場合のみ、値を取得します
                If item.getElementsByTagName("title").Length > 0 Then d_title = item.getElementsByTagName("title")(0).Text
                If item.getElementsByTagName("description").Length > 0 Then d_description = item.getElementsByTagName("description")(0).Text
                If item.getElementsByTagName("author").Length > 0 Then d_author = item.getElementsByTagName("author")(0).Text
                If item.getElementsByTagName("category").Length > 0 Then d_category1 = item.getElementsByTagName("category")(0).Text
                If item.getElementsByTagName("category").Length > 1 Then d_category2 = item.getElementsByTagName("category")(1).Text
                If item.getElementsByTagName("dc:title").Length > 0 Then d_dctitle = item.getElementsByTagName("dc:title")(0).Text
                If item.getElementsByTagName("dcndl:titleTranscription").Length > 0 Then d_dcndl_titleTranscription = item.getElementsByTagName("dcndl:titleTranscription")(0).Text
                If item.getElementsByTagName("dc:creator").Length > 0 Then d_dc_creator = item.getElementsByTagName("dc:creator")(0).Text
                If item.getElementsByTagName("dcndl:creatorTranscription").Length > 0 Then d_dcndl_creatorTranscription = item.getElementsByTagName("dcndl:creatorTranscription")(0).Text
                If item.getElementsByTagName("dcndl:seriesTitle").Length > 0 Then d_dcndl_seriesTitle = item.getElementsByTagName("dcndl:seriesTitle")(0).Text
                If item.getElementsByTagName("dcndl:seriesTitleTranscription").Length > 0 Then d_dcndl_seriesTitleTranscription = item.getElementsByTagName("dcndl:seriesTitleTranscription")(0).Text

                ' publisherが2件以上存在する場合、2件目を優先
                If item.getElementsByTagName("dc:publisher").Length > 1 Then
                    d_dc_publisher = item.getElementsByTagName("dc:publisher")(1).Text
                ElseIf item.getElementsByTagName("dc:publisher").Length > 0 Then
                    d_dc_publisher = item.getElementsByTagName("dc:publisher")(0).Text
                End If

                If item.getElementsByTagName("dcndl:publicationPlace").Length > 0 Then d_dcndl_publicationPlace = item.getElementsByTagName("dcndl:publicationPlace")(0).Text
                If item.getElementsByTagName("dc:date").Length > 0 Then d_dc_date = item.getElementsByTagName("dc:date")(0).Text
                If item.getElementsByTagName("dcterms:issued").Length > 0 Then d_dcterms_issued = item.getElementsByTagName("dcterms:issued")(0).Text
                If item.getElementsByTagName("dcndl:price").Length > 0 Then d_dcndl_price = item.getElementsByTagName("dcndl:price")(0).Text
                If item.getElementsByTagName("dc:extent").Length > 0 Then d_dc_extent = item.getElementsByTagName("dc:extent")(0).Text

                ' subjectタグが3件以上ある場合は3件目を、それ以外は1件目を利用
                If item.getElementsByTagName("dc:subject").Length > 2 Then
                    d_dc_subject = item.getElementsByTagName("dc:subject")(2).Text
                ElseIf item.getElementsByTagName("dc:subject").Length > 0 Then
                    d_dc_subject = item.getElementsByTagName("dc:subject")(0).Text
                Else
                    d_dc_subject = ""
                End If

                If item.getElementsByTagName("dc:description").Length > 0 Then d_dc_description = item.getElementsByTagName("dc:description")(0).Text

                ' Excelシートに書き込み
                ws.Cells(i, 3).Value = d_title
                ws.Cells(i, 4).Value = d_dcndl_titleTranscription
                ws.Cells(i, 5).Value = d_dc_subject
                ws.Cells(i, 6).Value = d_dcndl_seriesTitle
                ws.Cells(i, 7).Value = d_dcndl_seriesTitleTranscription
                ws.Cells(i, 8).Value = d_author
                ws.Cells(i, 9).Value = d_dc_creator
                ws.Cells(i, 10).Value = d_dcndl_creatorTranscription
                ws.Cells(i, 11).Value = d_dc_publisher
                ws.Cells(i, 12).Value = d_dc_date
                ws.Cells(i, 13).Value = d_dcterms_issued
                ws.Cells(i, 14).Value = d_dcndl_publicationPlace
                ws.Cells(i, 15).Value = d_dcndl_price
                ws.Cells(i, 16).Value = d_dc_extent
                ws.Cells(i, 17).Value = d_dc_description
                ws.Cells(i, 18).Value = RemoveHTMLTags(d_description) ' HTMLタグを除去した説明
                ws.Cells(i, 19).Value = d_category1 & "," & d_category2 ' カテゴリ情報（複数件をカンマ区切りで結合）
            End If
        End If
NextISBN:
    Next i
    
    ' 処理完了のメッセージ表示
    MsgBox "処理が完了しました。"
End Sub

４．さいごに

何かの足しになれば幸いです。