VBA is a horrible thing to work with; mostly because the development environment (if you can call it that) built in to Office 2013 stinks. You get lovely errors like “Access denied” when using the HTTP request component, or “-91”.
So, with a lot of looking things up on StackOverflow and other sources, I’ve re-written the code from the previous post to work with LibraryThing. LibraryThing requires a developer key, but it’s easy enough to get one after creating an account with them. Then you just need the magical getwork API call, and presto, an XML response awaiting your parsing pleasure.
StackOverflow references for this code:
- Setting a namespace for the XPath query, after getting frustrated that “//title” didn’t work.
- Using the Server variant of the HTTP fetcher, to get around the Access Denied errors when trying to fetch the HTTPS URL. Wireshark was saying that no packets were even going to the remote website.
- Tomalak’s fantastic answer with the bulk of the bits I needed to make this all work; I’m more at home in Python.
Option Explicit Sub ISBN() Dim urlBase As String Dim libraryThingDoc As MSXML2.DOMDocument60 Dim oSeqNodes As IXMLDOMNode Dim r As String Dim title As String urlBase = "http://www.librarything.com/services/rest/1.1/?method=librarything.ck.getwork&apikey=API_KEY_GOES_HERE&isbn=" Do r = CStr(ActiveCell.Value) title = Nothing Set libraryThingDoc = GetXmlDoc(urlBase + r) libraryThingDoc.setProperty "SelectionNamespaces", "xmlns:a='http://www.librarything.com/'" title = libraryThingDoc.SelectSingleNode("//a:title").Text On Error Resume Next ActiveCell.Offset(0, 1).Value = title ActiveCell.Offset(1, 0).Select Loop Until IsEmpty(ActiveCell.Value) End Sub Private Function GetText(context As IXMLDOMNode, path As String) As String Dim result As IXMLDOMNode If Not context Is Nothing Then Set result = context.SelectSingleNode(path) If Not result Is Nothing Then GetText = result.Text End If End Function Private Function GetXmlDoc(url As String) As MSXML2.DOMDocument60 With New MSXML2.ServerXMLHTTP60 .Open "GET", url, False .send If .Status = 200 Then If .responseXML.parseError.ErrorCode = 0 Then Set GetXmlDoc = .responseXML Else Err.Raise vbObjectError + 1, "GetXmlDoc", "XML parser error: " & .responseXML.parseError.reason End If Else Err.Raise vbObjectError + 2, "GetXmlDoc", "Server responded with status code " & .Status End If End With End Function