Список книг-получение сведений о книге из amazon с помощью поиска штрих-кодов Excel VBA
У меня есть считыватель штрих-кодов и куча книг. Для каждой книги я хочу перечислить название книги и автора в электронной таблице Excel.
Я считаю, что некоторые VBA-коды, подключенные к веб-сервису Amazon, облегчат это.
Мои вопросы - разве никто не делал этого раньше? Не могли бы вы указать мне на лучший пример?
4 ответа:
Я думал, что это было легко гуглить, но оказалось сложнее, чем я ожидал.
На самом деле, я не смог найти программу на основе VBA ISBN для получения данных о книгах из интернета, поэтому решил сделать это.Вот макрос VBA, использующий сервисы из xisbn.worldcat.org . примеры здесь.. Услуги бесплатны и не требуют аутентификации.
Чтобы иметь возможность запустить его, вы должны проверить в меню Сервис - > ссылки (в окне 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
Я не пошел через Amazon из-за их нового "простого" протокола аутентификации ...
Это было чрезвычайно полезно для меня!
Я обновил макрос, чтобы он мог циклически перемещаться по столбцу чисел 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
Я только что нашел эту нить, когда пытался сделать то же самое. К сожалению, я на 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
Это вернет название этой книги. Конечно, вы можете применить эту формулу ко всем ISBNs в столбце А поискать несколько названий, или авторов, или еще что-нибудь.
getAttributeForISBN("1568812019","title")
Надеюсь, это поможет кому-то еще!