Danh sách sách - lấy chi tiết sách từ amazon sử dụng tra cứu mã vạch Excel VBA

Question

Tôi có đầu đọc mã vạch và một loạt sách. Đối với mỗi cuốn sách, tôi muốn liệt kê tên sách và tác giả trong bảng tính Excel.

Quan điểm của tôi là một số mã VBA kết nối với dịch vụ web của Amazon sẽ giúp việc này trở nên dễ dàng hơn.

Câu hỏi của tôi là - chưa có ai thực hiện việc này trước đây chưa? Bạn có thể chỉ cho tôi ví dụ tốt nhất không.

Answer 1

Tôi nghĩ đó là một điều dễ dàng googling, nhưng hóa ra khó khăn hơn tôi mong đợi.

Thực tế, tôi không thể tìm thấy chương trình dựa trên ISBN VBA để lấy dữ liệu sách từ web, vì vậy hãy quyết định làm một.

Đây là macro VBA sử dụng dịch vụ từ xisbn.worldcat.org. Ví dụ: here.. Các dịch vụ này miễn phí và không cần xác thực.

Để có thể chạy nó, bạn nên kiểm tra tại Tools-> Tham khảo (trong cửa sổ VBE) thư viện "Microsoft xml 6.0".

Macro này lấy ISBN (10 chữ số) từ ô hiện tại và điền vào hai cột sau với tác giả và tiêu đề. Bạn sẽ có thể lặp qua một cột đầy đủ một cách dễ dàng.

Mã đã được kiểm tra (tốt, một chút) nhưng không có lỗi kiểm tra trong đó.

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 

tôi đã không đi qua Amazon vì giao thức mới "đơn giản" xác thực của họ ...

Answer 2

Nếu mã vạch là ISBN, mà dường như có khả năng, có lẽ bạn có thể sử dụng: amazon.com/Advanced-Search-Books/b?ie=UTF8 & node = 241582011

Answer 3

này đã vô cùng hữu ích đối với tôi!

Tôi đã cập nhật macro để cho phép nó quay vòng qua một cột số ISBN cho đến khi nó đến một ô trống.

Nó cũng tìm kiếm nhà xuất bản, năm và ấn bản.

Tôi đã thêm một số kiểm tra lỗi cơ bản nếu một số trường không có sẵn.

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

Tôi chỉ tìm thấy chuỗi này khi tôi đang cố làm điều tương tự. Thật không may tôi đang ở trên một MAC, do đó, những câu trả lời không giúp đỡ. Với một chút nghiên cứu, tôi đã có thể làm cho nó hoạt động trong MAC Excel với module này:

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 

Đây không phải là tất cả các công việc ban đầu của tôi, tôi dán nó lại với nhau từ một trang web khác, sau đó làm việc của riêng tôi. Bây giờ bạn có thể làm những việc như:

getAttributeForISBN("1568812019","title")

này sẽ trở lại tiêu đề của cuốn sách đó. Tất nhiên bạn có thể áp dụng công thức này cho tất cả các ISBN trong cột A để tra cứu nhiều tên sách, tác giả hoặc bất kỳ thứ gì.

Hy vọng điều này sẽ giúp người khác ra khỏi đó!