圖書清單 - 使用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以查找多個標題或作者等等。

希望這可以幫助別人！