使用 VBA 在 EXCEL 中输入 ISBN 解析 Google Books JSON 以获取图书信息

Question

我构建了一个 VBA 代码，以便通过输入我之前使用我的手机使用条形扫描仪应用扫描的图书的 ISBN 代码从 Google Books API 获取数据。 使用VBA-JSON 库，一切似乎都还可以，但我仍然有一个无法导入的对象。

我用来检查代码是否有效的 JSON 文件是这样的：

https://www.googleapis.com/books/v1/volumes?q=isbn:9780553897852

这是我现在用来挑选数据的代码：

Public Sub exceljson()

'Error message if active cell is empty
If ActiveCell.Value = 0 Then
     MsgBox "Select cell with ISBN", vbExclamation
     Exit Sub
End If

'Error message if there is no match
On Error GoTo ErrMsg

Dim http As Object, JSON As Object, i As Integer, subitem As Object
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://www.googleapis.com/books/v1/volumes?q=isbn:" & ActiveCell.Value, False
http.send
Set JSON = ParseJson(http.responseText)

i = ActiveCell.Row
For Each Item In JSON("items")
Set subitem = Item("volumeInfo")
Sheets(1).Cells(i, ActiveCell.Column + 1).Value = subitem("publishedDate")
Sheets(1).Cells(i, ActiveCell.Column + 2).Value = subitem("title")
Sheets(1).Cells(i, ActiveCell.Column + 3).Value = subitem("subtitle")
Sheets(1).Cells(i, ActiveCell.Column + 4).Value = subitem("pageCount")

'To obtain ISBN-10 and ISBN-13
j = 5
For Each Child In subitem("industryIdentifiers")
Sheets(1).Cells(i, ActiveCell.Column + j).Value = Child("identifier")
j = j + 1
Next
i = i + 1

'To end with success
Next
MsgBox ("Process complete"), vbInformation
Exit Sub

'To en with an error message
ErrMsg:
MsgBox ("No match obtained"), vbCritical

End Sub

This is the resulted EXCEL sheet I made

实际上，我在 ActiveCell 的后续单元格中显示了以下字段：出版年份、标题、副标题、页数、ISBN-10、ISBN-13 我写的是 ISBN。 但是我不知道如何从“作者”数组中收集数据。 是我唯一想念的数据字段，所以如果你能帮助我，我真的很感激。 提前致谢。

Answer 1

以下显示了作者的正确路径。 {} 表示通过键访问的字典，[] 表示通过索引访问的集合。请注意，图像中的 0 索引基实际上是所用库的 1 基。

Option Explicit

Public Sub GetInfo()
    Const URL As String = "https://www.googleapis.com/books/v1/volumes?q=isbn:9780553897852"
    Dim json As Object
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        Set json = JsonConverter.ParseJson(.responseText)
    End With
    Debug.Print json("items")(1)("volumeInfo")("authors")(1)
End Sub

您还可以在此处查看该路径：

---

根据你的逻辑，你需要

Option Explicit
Public Sub GetInfo()
    Const URL As String = "https://www.googleapis.com/books/v1/volumes?q=isbn:9780553897852"
    Dim json As Object
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        Set json = JsonConverter.ParseJson(.responseText)
    End With
    'Debug.Print json("items")(1)("volumeInfo")("authors")(1)
    Dim item As Object, item2 As Variant, subItem As Object, r As Long, c As Long
    For Each item In json("items")
        Set subItem = item("volumeInfo")
        If subItem.Exists("authors") Then
            r = r + 1: c = 1
            For Each item2 In subItem("authors")
                ActiveSheet.Cells(r, c) = item2
                c = c + 1
            Next
        End If
    Next
End Sub

Answer 2

查看您从中检索的网页中的数据，"authors" 看起来像 subitem 的 Item("volumeInfo")。如果"authors" 以数组形式读取，您可以使用

将其拉入单元格

Sheets(1).Cells(i, ActiveCell.Column + 5).Value = Join(subitem("authors"),",")

或者如果它只是一个字符串，那么你可以使用

Sheets(1).Cells(i, ActiveCell.Column + 5).Value = subitem("authors")

然后使j = 6 防止覆盖输出。