Book list - getting book details from amazon using Excel VBA barcode lookups

Question

I have a barcode reader and bunch of books. For each of the books, I want to list the book name and the author in an Excel spreadsheet.

My view is that some VBA code connecting to an Amazon web service would make this easier.

My questions is - hasn't anyone done this before? Could you point me to the best example.

Answer 1

I thought it was an easy one googling, but turned out more difficult than I expected.

In fact, I was unable to find a VBA ISBN based program to get book data from the web, so decided to do one.

Here is a VBA macro using the services from xisbn.worldcat.org. Examples here.. The services are free and don't need authentication.

To be able to run it you should check at Tools-> References (in the VBE window) the "Microsoft xml 6.0" library.

This macro takes the ISBN (10 digits) from the current cell and fills the following two columns with the author and title. You should be able to loop through a full column easily.

The code has been tested (well, a bit) but there is no error checking in there.

 Sub xmlbook()
 Dim xmlDoc As DOMDocument60
 Dim xWords As IXMLDOMNode
 Dim xType As IXMLDOMNode
 Dim xword As IXMLDOMNodeList
 Dim xWordChild As IXMLDOMNode
 Dim oAttributes As IXMLDOMNamedNodeMap
 Dim oTitle As IXMLDOMNode
 Dim oAuthor As IXMLDOMNode
 Set xmlDoc = New DOMDocument60
 Set xWords = New DOMDocument60
 xmlDoc.async = False
 xmlDoc.validateOnParse = False
 r = CStr(ActiveCell.Value)

 xmlDoc.Load ("http://xisbn.worldcat.org/webservices/xid/isbn/" _
              + r + "?method=getMetadata&format=xml&fl=author,title")

 Set xWords = xmlDoc

     For Each xType In xWords.ChildNodes
         Set xword = xType.ChildNodes
         For Each xWordChild In xword
             Set oAttributes = xWordChild.Attributes
             On Error Resume Next
             Set oTitle = oAttributes.getNamedItem("title")
             Set oAuthor = oAttributes.getNamedItem("author")
             On Error GoTo 0
         Next xWordChild
     Next xType
  ActiveCell.Offset(0, 1).Value = oTitle.Text
  ActiveCell.Offset(0, 2).Value = oAuthor.Text
 End Sub

I did not go through Amazon because of their new "straightforward" authentication protocol ...

Answer 2

This is has been enormously helpful for me!

I have updated the macro to allow it to cycle through a column of ISBN numbers until it reaches an empty cell.

It also search for publisher, year and edition.

I have added some basic error checking if certain fields are not available.

Sub ISBN()
 Do
 Dim xmlDoc As DOMDocument60
 Dim xWords As IXMLDOMNode
 Dim xType As IXMLDOMNode
 Dim xword As IXMLDOMNodeList
 Dim xWordChild As IXMLDOMNode
 Dim oAttributes As IXMLDOMNamedNodeMap
 Dim oTitle As IXMLDOMNode
 Dim oAuthor As IXMLDOMNode
 Set xmlDoc = New DOMDocument60
 Set xWords = New DOMDocument60
 xmlDoc.async = False
 xmlDoc.validateOnParse = False
 r = CStr(ActiveCell.Value)

 xmlDoc.Load ("http://xisbn.worldcat.org/webservices/xid/isbn/" _
              + r + "?method=getMetadata&format=xml&fl=author,title,year,publisher,ed")

 Set xWords = xmlDoc

     For Each xType In xWords.ChildNodes
         Set xword = xType.ChildNodes
         For Each xWordChild In xword
             Set oAttributes = xWordChild.Attributes
             On Error Resume Next
             Set oTitle = oAttributes.getNamedItem("title")
             Set oAuthor = oAttributes.getNamedItem("author")
             Set oPublisher = oAttributes.getNamedItem("publisher")
             Set oEd = oAttributes.getNamedItem("ed")
             Set oYear = oAttributes.getNamedItem("year")
             On Error GoTo 0
         Next xWordChild
     Next xType
  On Error Resume Next
  ActiveCell.Offset(0, 1).Value = oTitle.Text

  On Error Resume Next
  ActiveCell.Offset(0, 2).Value = oAuthor.Text

  On Error Resume Next
  ActiveCell.Offset(0, 3).Value = oPublisher.Text

  On Error Resume Next
  ActiveCell.Offset(0, 4).Value = oYear.Text

  On Error Resume Next
  ActiveCell.Offset(0, 5).Value = oEd.Text


  ActiveCell.Offset(1, 0).Select
  Loop Until IsEmpty(ActiveCell.Value)

 End Sub

Answer 3

I just found this thread as I was attempting to do the same thing. Unfortunately I'm on a MAC, so these answers don't help. With a bit of research I was able to do get it to work in MAC Excel with this module:

Option Explicit

' execShell() function courtesy of Robert Knight via StackOverflow
' http://stackoverflow.com/questions/6136798/vba-shell-function-in-office-    2011-for-mac

Private Declare Function popen Lib "libc.dylib" (ByVal command As String,       ByVal mode As String) As Long
Private Declare Function pclose Lib "libc.dylib" (ByVal file As Long) As Long
Private Declare Function fread Lib "libc.dylib" (ByVal outStr As String, ByVal size As Long, ByVal items As Long, ByVal stream As Long) As Long
Private Declare Function feof Lib "libc.dylib" (ByVal file As Long) As Long

Function execShell(command As String, Optional ByRef exitCode As Long) As String
    Dim file As Long
    file = popen(command, "r")

    If file = 0 Then
        Exit Function
    End If

    While feof(file) = 0
        Dim chunk As String
        Dim read As Long
        chunk = Space(50)
        read = fread(chunk, 1, Len(chunk) - 1, file)
        If read > 0 Then
            chunk = Left$(chunk, read)
            execShell = execShell & chunk
        End If
    Wend

    exitCode = pclose(file)
End Function

Function HTTPGet(sUrl As String) As String

    Dim sCmd As String
    Dim sResult As String
    Dim lExitCode As Long
    Dim sQuery As String

    sQuery = "method=getMetadata&format=xml&fl=*"
    sCmd = "curl --get -d """ & sQuery & """" & " " & sUrl
    sCmd = "curl --get -d """ & sQuery & """" & " " & sUrl

    sResult = execShell(sCmd, lExitCode)

    ' ToDo check lExitCode

    HTTPGet = sResult

End Function

Function getISBNData(isbn As String) As String
  Dim sUrl As String
  sUrl = "http://xisbn.worldcat.org/webservices/xid/isbn/" & isbn
  getISBNData = HTTPGet(sUrl)

End Function



Function getAttributeForISBN(isbn As String, info As String) As String
  Dim data As String
  Dim start As Integer
  Dim finish As Integer


 data = getISBNData(isbn)
 start = InStr(data, info) + Len(info) + 2
 finish = InStr(start, data, """")
 getAttributeForISBN = Mid(data, start, finish - start)


End Function

This is not all my original work, I pasted it together from another site, then did my own work. Now you can do things like:

getAttributeForISBN("1568812019","title")

This will return the title of that book. Of course you can apply this formula to all of the ISBNs in column A to look up multiple titles, or authors, or whatever.

Hopefully this helps someone else out there!