2010-10-11 19 views
10

Tengo un lector de código de barras y un montón de libros. Para cada uno de los libros, deseo enumerar el nombre del libro y el autor en una hoja de cálculo de Excel.Lista de libros - obtener detalles del libro de Amazon usando las búsquedas de códigos de barras de Excel VBA

Mi opinión es que algún código de VBA que se conecte a un servicio web de Amazon lo haría más fácil.

Mi pregunta es: ¿nadie ha hecho esto antes? ¿Podría señalarme el mejor ejemplo?

Respuesta

16

pensé que era una tarea fácil Google, pero resultó más difícil de lo que esperaba.

De hecho, no pude encontrar un programa basado en el ISBN de VBA para obtener datos de libros de la web, así que decidí hacer uno.

Aquí hay una macro de VBA utilizando los servicios de xisbn.worldcat.org. Ejemplos here.. Los servicios son gratuitos y no necesitan autenticación.

Para poder ejecutarlo debe comprobar en Herramientas-> Referencias (en la ventana VBE) la biblioteca "Microsoft xml 6.0".

Esta macro toma el ISBN (10 dígitos) de la celda actual y rellena las dos columnas siguientes con el autor y el título. Debería poder recorrer fácilmente una columna completa.

El código ha sido probado (bueno, un poco) pero no hay ningún error de comprobación allí.

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 

No fui a través de Amazon debido a su nuevo protocolo de autenticación "simple" ...

+2

+1 para el buen ejemplo de consumir un servicio web! –

+0

¡Justo lo que estaba buscando! ¡La característica de no renovación de PowerPivot será embotellada! ;) – LamonteCristo

0

Si el código de barras es el ISBN, lo que parece probable, tal vez se puede utilizar: amazon.com/Advanced-Search-Books/b?ie=UTF8 & nodo = 241582011

+0

Supongo que el problema OP es cómo obtener el título del libro en una celda –

+0

A menudo se publica información sobre cómo agarrar desde una página web usando Excel, por lo que no debería ser una búsqueda difícil. – Fionnuala

+0

no encontró nada realmente útil para analizar HTML en VBA. Escribí una respuesta usando XML. ¿Te importa compartir un buen puntero para el análisis de HTML en VBA en tu respuesta (no la solución .qry que solo hace frente a las tablas)? Tnx! –

3

esto es, ha sido de gran ayuda para mí!

He actualizado la macro para permitir que pase por una columna de números ISBN hasta que llegue a una celda vacía.

También busca el editor, el año y la edición.

He agregado algunas comprobaciones de errores básicos si ciertos campos no están disponibles.

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 
2

Acabo de encontrar este hilo porque estaba intentando hacer lo mismo. Lamentablemente, estoy en un MAC, por lo que estas respuestas no ayudan. Con un poco de investigación que era capaz de hacer llegar a trabajar en MAC Excel con este módulo:

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 

Esto no es todo mi trabajo original, pegué juntos desde otro sitio, y luego hice mi propio trabajo. Ahora puede hacer cosas como:

getAttributeForISBN("1568812019","title")

Esto devolverá el título de ese libro. Por supuesto, puede aplicar esta fórmula a todos los ISBN en la columna A para buscar varios títulos, autores o lo que sea.

¡Espero que esto ayude a alguien más!

Cuestiones relacionadas