戻る　

■　楽天から図書情報を取得する　　　2011/9/9 22:00

参考URL　　futadaさんのdiary：　http://d.hatena.ne.jp/futada/20100210/1265786012
　　　　　　　続・Excel VBAで楽天ブックス書籍検索API(ISBN→書籍名)　　　　　　　　　　　　　


手順　１　　楽天会員になる。
　　　　２　　楽天WEBサービス　デベロッパーＩＤを調べる。
　　　　３　　「図書データ取得from楽天.xls」（excel97〜2003形式）を開いて、デベロッパーIDとISBNコードを入力すると、
　　　　　　　図書名、著者、出版社名が取得できる。
　　　　　　　注）当然、楽天データベースにないものは表示されない。
　　　　　　　注）ISBN入力行を増やすことは、表示させる関数式のセルも増えることであり、関数式が増えれば、楽天へのアクセスが増えることであり
　　　　　　　　　楽天では過度なアクセスがあった場合は一時的にアクセスを停止するようだ。どれほどのアクセスが過度かどうかは不明。
　　　　　　　　　5件のISBNが入力できるようになっているが、すべて入力して計算＝楽天へのアクセス＝すると過度にあたるかどうかも不明。
　　　　　　　　　自己責任で使用してください。


［図書データ取得from楽天.xls］ Functionシート

　B1には、楽天デベロッパーIDを入力する。
　上の図では、B1セルが空欄のままで書名や著者名が表示されているが、B1セルにIDを入力しないと本来表示されないが、
　サンプルとして表示結果を載せている。

　B4〜D8のセル範囲に、マクロfunction関数が入力されている。
futadaさんのソースを一部修正。あとは、流用して、著者・出版社表示させるようにした。

Function getTitleFromISBN(developerID As String, ISBN As String) As String
Dim xml, result As Object
Dim url, status As String

url = "http://api.rakuten.co.jp/rws/3.0/rest?" 　　　　　　'2011/9/9変更
url = url & "developerId=" & developerID
url = url & "&operation=BooksBookSearch"
url = url & "&version=2011-07-07" 　　　　　　　　　　　　　'2011/9/9変更
url = url & "&isbn=" & ISBN

Set xml = CreateObject("Microsoft.XMLDOM")
xml.async = False
xml.Load (url)

status = xml.SelectSingleNode("/Response/header:Header/Status").nodeTypedValue
If (status <> "Success") Then
getTitleFromISBN = status
Exit Function
End If

Set result = xml.SelectSingleNode("/Response/Body/booksBookSearch:BooksBookSearch/Items/Item")
getTitleFromISBN = result.SelectSingleNode("title").nodeTypedValue
End Function

'　↓著者名の表示
Function getTitleFromISBN2(developerID As String, ISBN As String) As String
Dim xml, result As Object
Dim url, status As String

url = "http://api.rakuten.co.jp/rws/3.0/rest?" 　　　　　　　　　'2011/9/9変更
url = url & "developerId=" & developerID
url = url & "&operation=BooksBookSearch"
url = url & "&version=2011-07-07" 　　　　　　　　　　　　　　　'2011/9/9変更
url = url & "&isbn=" & ISBN

Set xml = CreateObject("Microsoft.XMLDOM")
xml.async = False
xml.Load (url)

status = xml.SelectSingleNode("/Response/header:Header/Status").nodeTypedValue
If (status <> "Success") Then
getTitleFromISBN2 = status
Exit Function
End If

Set result = xml.SelectSingleNode("/Response/Body/booksBookSearch:BooksBookSearch/Items/Item")
getTitleFromISBN2 = result.SelectSingleNode("author").nodeTypedValue
End Function

［図書データ取得from楽天.xls］ SUBシート

　Functionシートと違って、SubシートはISBN番号を入力後「isbn取得」ボタンクリックで、データを取得します。

VBAソース。

Sub GetFromISBN() 'developerID As String, ISBN As String) As String
Dim xml, result As Object
Dim url, status As String
Dim Taitoru, Sakusya, Syuppansya, Komento As String
Dim ISBN, developerID As String
Dim i, j As Long

developerID = ActiveSheet.Range("b1").Value

Range("b4:e8").ClearContents

For i = 4 To 8
ISBN = Range("a" & i).Value

url = "http://api.rakuten.co.jp/rws/3.0/rest?" '変更
url = url & "developerId=" & developerID
url = url & "&operation=BooksBookSearch"
url = url & "&version=2011-07-07" ' 変更
url = url & "&isbn=" & ISBN

Set xml = CreateObject("Microsoft.XMLDOM")
xml.async = False
xml.Load (url)

status = xml.SelectSingleNode("/Response/header:Header/Status").nodeTypedValue
If (status <> "Success") Then
' getTitleFromISBN = status
MsgBox "楽天WEBデータベースに接続できませんでした。"
'Exit sub
GoTo tugihe
End If

Set result = xml.SelectSingleNode("/Response/Body/booksBookSearch:BooksBookSearch/Items/Item")
Taitoru = result.SelectSingleNode("title").nodeTypedValue
Sakusya = result.SelectSingleNode("author").nodeTypedValue
Syuppansya = result.SelectSingleNode("publisherName").nodeTypedValue
Komento = result.SelectSingleNode("itemCaption").nodeTypedValue

Range("b" & i) = Taitoru
Range("c" & i) = Sakusya
Range("d" & i) = Syuppansya
Range("e" & i) = Komento

tugihe:

Next i

End Sub

その他の項目やCD/DVDなどの検索については、下記を参照のこと。
楽天ブックス書籍検索API (version:2011-07-07)
http://webservice.rakuten.co.jp/api/booksbooksearch/#INDEX01

ダウンロード：　図書データ取得from楽天.xls　（tosyo_data_from_rakuten.zip）

戻　る