图书清单 - 使用Excel VBA条码查询从亚马逊获取书籍详细信息

Question

我有一个条形码阅读器和一堆书。对于每本书，我都想在Excel电子表格中列出书名和作者。

我的观点是，连接到亚马逊网络服务的一些VBA代码会使这更容易。

我的问题是 - 以前没有人做过这件事吗？你能指出我最好的例子吗？

Answer 1

我认为这是一个容易谷歌搜索，但结果比我预期的更困难。

事实上，我无法找到一个基于VBA ISBN的程序从网上获取书籍数据，所以决定做一个。

这是一个使用xisbn.worldcat.org服务的VBA宏。示例here.。这些服务是免费的，不需要认证。

为了能够运行它，你应该检查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 

我没有去通过亚马逊，因为他们的新的“直白”的身份验证协议的...

Answer 2

如果条形码是ISBN，这似乎是有可能的，也许你可以使用：amazon.com/Advanced-Search-Books/b?ie=UTF8 &节点= 241582011

Answer 3

这一直是我很大的帮助！

我已经更新了宏，允许它循环通过一列的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 4

我刚刚发现这个线索，我正在试图做同样的事情。不幸的是我在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")

这将返回那本书的标题。当然，您可以将此公式应用于A列中的所有ISBN以查找多个标题或作者等等。

希望这可以帮助别人！