Список книг-получение сведений о книге из amazon с помощью поиска штрих-кодов Excel VBA


У меня есть считыватель штрих-кодов и куча книг. Для каждой книги я хочу перечислить название книги и автора в электронной таблице Excel.

Я считаю, что некоторые VBA-коды, подключенные к веб-сервису Amazon, облегчат это.

Мои вопросы - разве никто не делал этого раньше? Не могли бы вы указать мне на лучший пример?

4 10

4 ответа:

Я думал, что это было легко гуглить, но оказалось сложнее, чем я ожидал.

На самом деле, я не смог найти программу на основе VBA ISBN для получения данных о книгах из интернета, поэтому решил сделать это.

Вот макрос VBA, использующий сервисы из xisbn.worldcat.org . примеры здесь.. Услуги бесплатны и не требуют аутентификации.

Чтобы иметь возможность запустить его, вы должны проверить в меню Сервис - > ссылки (в окне VBE) "Microsoft xml 6.0" библиотека.

Этот макрос берет ISBN (10 цифр) из текущей ячейки и заполняет следующие два столбца автором и заголовком. Вы должны быть в состоянии сделать петлю через полный столбец легко.

Код был протестирован (ну, немного), но там нет проверки ошибок.

 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

Я не пошел через Amazon из-за их нового "простого" протокола аутентификации ...

Это было чрезвычайно полезно для меня!

Я обновил макрос, чтобы он мог циклически перемещаться по столбцу чисел ISBN, пока не достигнет пустой ячейки.

Это также поиск издателя, года и издания.

Я добавил некоторые основные ошибки проверки, если некоторые поля недоступны.

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

Я только что нашел эту нить, когда пытался сделать то же самое. К сожалению, я на MAC, так что эти ответы не помогут. Проведя небольшое исследование, я смог заставить его работать в Mac Excel с помощью этого модуля:

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
Это не вся моя оригинальная работа, я склеил ее с другого сайта, а затем сделал свою собственную работу. Теперь вы можете делать такие вещи, как:

getAttributeForISBN("1568812019","title")

Это вернет название этой книги. Конечно, вы можете применить эту формулу ко всем ISBNs в столбце А поискать несколько названий, или авторов, или еще что-нибудь.

Надеюсь, это поможет кому-то еще!

Если штрих-код ISBN, что кажется вероятным, возможно, вы можете использовать: amazon.com/Advanced-Search-Books/b?ie=UTF8&node=241582011