2010-10-11 12 views
10

मेरे पास बारकोड रीडर और पुस्तकें हैं। प्रत्येक पुस्तक के लिए, मैं एक्सेल स्प्रेडशीट में पुस्तक का नाम और लेखक सूचीबद्ध करना चाहता हूं।पुस्तक सूची - एक्सेल वीबीए बारकोड लुकअप का उपयोग करके अमेज़ॅन से पुस्तक विवरण प्राप्त करना

मेरा विचार यह है कि कुछ अमेज़ॅन वेब सेवा से कनेक्ट होने वाला वीबीए कोड यह आसान बना देगा।

मेरे प्रश्न हैं - क्या इससे पहले कोई भी ऐसा नहीं किया है? क्या आप मुझे सबसे अच्छे उदाहरण के लिए इंगित कर सकते हैं।

उत्तर

16

मैंने सोचा कि यह एक आसान से एक था गुगलिंग, लेकिन मेरी अपेक्षा से अधिक कठिन हो गया।

वास्तव में, मैं वेब से पुस्तक डेटा प्राप्त करने के लिए एक वीबीए आईएसबीएन आधारित प्रोग्राम नहीं ढूंढ पाया, इसलिए एक करने का फैसला किया।

यहां xisbn.worldcat.org से सेवाओं का उपयोग कर एक वीबीए मैक्रो है। उदाहरण here.। सेवाएं निःशुल्क हैं और प्रमाणीकरण की आवश्यकता नहीं है।

इसे चलाने में सक्षम होने के लिए आपको "माइक्रोसॉफ्ट एक्सएमएल 6.0" लाइब्रेरी में टूल्स-> संदर्भ (वीबीई विंडो में) पर जांच करनी चाहिए।

यह मैक्रो वर्तमान सेल से आईएसबीएन (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 

मैं अपने नए "सरल" प्रमाणीकरण प्रोटोकॉल की वजह से अमेज़न के माध्यम से जाना नहीं था ...

+2

+1 में अच्छा सुझाव! –

+0

बस जो मैं खोज रहा था! PowerPivot गैर-ताज़ा सुविधा क्षतिग्रस्त हो! ;) – LamonteCristo

0

बारकोड ISBN, जो संभावना लगती है, तो शायद आप उपयोग कर सकते हैं: amazon.com/Advanced-Search-Books/b?ie=UTF8 & नोड = 241582011

+0

मुझे लगता है कि ओपी समस्या कैसे एक्सेल का उपयोग कर किसी वेब पृष्ठ से एक सेल –

+0

बना रहे की जानकारी के बारे में अक्सर पोस्ट किया जाता है में पुस्तक का शीर्षक प्राप्त करने के लिए है, इसलिए यह एक मुश्किल खोज नहीं होना चाहिए। – Fionnuala

+0

को वीबीए में एचटीएमएल पार्स करने के लिए वास्तव में कुछ भी उपयोगी नहीं मिला। मैंने XML का उपयोग करके एक उत्तर लिखा। क्या आप अपने उत्तर में वीबीए में एचटीएमएल पार्सिंग के लिए एक अच्छा सूचक साझा करना चाहते हैं (.qry समाधान नहीं जो केवल टेबल के साथ copes!)? Tnx! –

3

यह मेरे लिए काफी उपयोगी है कर रहा है!

मैंने मैक्रो को अद्यतन किया है ताकि इसे एक खाली सेल तक पहुंचने तक आईएसबीएन संख्याओं के कॉलम के माध्यम से चक्र की अनुमति दी जा सके।

यह प्रकाशक, वर्ष और संस्करण की भी खोज करता है।

मैंने कुछ बुनियादी त्रुटि जांचने में कुछ बुनियादी त्रुटि जांच की है।

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

मुझे यह धागा मिला क्योंकि मैं वही काम करने का प्रयास कर रहा था। दुर्भाग्य से मैं मैक पर हूं, इसलिए ये उत्तर मदद नहीं करते हैं। अनुसंधान के एक बिट के साथ मैं इसे इस मॉड्यूल के साथ मैक 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")

यह है कि पुस्तक का शीर्षक वापस आ जाएगी। बेशक आप एकाधिक सूत्रों, लेखकों, या जो कुछ भी देखने के लिए कॉलम ए में सभी आईएसबीएन में इस फॉर्मूला को लागू कर सकते हैं।

उम्मीद है कि यह किसी और की मदद करता है!

संबंधित मुद्दे