我有一个条形码阅读器和一堆书。对于每本书,我想在Excel电子表格中列出书名和作者。
我的观点是,一些连接到Amazon Web服务的VBA代码会使这更容易。
我的问题是 - 以前没有人这样做过吗?你能指点我最好的例子吗?
答案 0 :(得分:16)
我认为这是一个简单的谷歌搜索,但结果比我预期更困难。
事实上,我无法找到基于VBA ISBN的程序来从网上获取图书数据,所以决定做一个。
以下是使用xisbn.worldcat.org中的服务的VBA宏。示例here.。这些服务是免费的,不需要身份验证。
为了能够运行它,你应该检查工具 - >引用(在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
由于他们新的“直截了当”的身份验证协议,我没有通过亚马逊......
答案 1 :(得分: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
答案 2 :(得分:2)
我刚刚发现这个帖子,因为我试图做同样的事情。不幸的是我在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,以查找多个标题,作者或其他任何内容。
希望这有助于其他人!
答案 3 :(得分:0)
如果条形码是ISBN,这似乎很可能,您可以使用:amazon.com/Advanced-Search-Books/b?ie=UTF8&node=241582011