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

Question

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

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

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

Answer 1

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

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

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

Чтобы запустить его, вам нужно проверить в Tools-> References (в окне 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 из-за их нового "простого" протокола аутентификации ...

Answer 2

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

Я обновил макрос, чтобы он мог циклически проходить по столбцу номеров 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

Answer 3

Я только что нашел эту ветку, когда пытался сделать то же самое.К сожалению, я на 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")

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

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

Answer 4

Если штрих-кодом является ISBN, что, вероятно, вероятно, вы можете использовать