用于从 ISBN 编号列表中提取书名的 Excel 文件答案

【问题标题】：Excel file to pull book titles from a list of ISBN Numbers用于从 ISBN 编号列表中提取书名的 Excel 文件
【发布时间】：2022-11-19 01:26:21
【问题描述】：

我正在尝试从谷歌中提取书名并获得一些代码 - 它只是运行不正确并且不断出现错误。我认为这很简单我只是看不到它:-)

看代码....如果将其放入 excel 中，我会尝试各种方法，但我需要能够将 ISBN 粘贴到 col A 中，然后在 Col B 中查看结果

Sub Tester()

    Dim jsonBooks As Object, auth, authInfo As Object, k
    Dim jsonBook As Object, bookDetails As Object
Set cell_range = Range("A1:A10")
    
For Each cell In cell_range
    Set jsonBooks = BookInfo(ActiveSheet.Cells(r, "A").Value)
    
    'Note: the aPI only returns `{}` if there's no match to
    '      the ISBN, not (eg) status=404
    If Not jsonBooks Is Nothing Then
        If jsonBooks.Count = 0 Then
            Debug.Print "No results"
        Else
            For Each k In jsonBooks
                Debug.Print "-------" & k & "----------"
                Set jsonBook = jsonBooks(k)
                Set bookDetails = jsonBook("details")
                Debug.Print "Title:", bookDetails("title")
                Debug.Print "Pub. Date:", bookDetails("publish_date")
                For Each auth In bookDetails("authors")
                    Debug.Print "Author:", auth("name")
                Next auth
            Next k
          End If
         End If
Next

     End Sub


Function BookInfo(ISBN) As Object
    Dim url As String
    url = "https://openlibrary.org/api/books?bibkeys=ISBN:" & ISBN & "&jscmd=details&format=json"
    Set BookInfo = responseObject(url)
End Function

Function responseObject(url As String) As Object
    Dim json As Object, http As Object
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", url, False
        .send
        'Debug.Print .Status, .responseText
        If .Status = 200 Then
            'Set responseObject = JsonConverter.ParseJson(.responseText)
            ThisWorkbook.Worksheets("Sheet1").Cells(2, 3) = .responseText
        Else
            Debug.Print .responseText, .Status
        End If
    End With
End Function

【问题讨论】：

你得到什么错误？你调试过你的代码吗？您的代码中的 r 是什么？你为什么循环单元格范围如果你不使用它？
试图调试 - 不确定为什么 R 在那里 - 这是其他人的建议......
您是否测试过从某人那里获得的初始代码？有用吗？请尝试BookInfo(cell) 而不是使用 ActiveSheet.Cells。您在代码中删除 JsonConverter 是否有原因？
原始代码只是在寻找代码本身内的 1 x ISBN ...通缉。不知道为什么 Json 转换器被删除...我一直在玩这个，只是无法让它做我想做的事... :-( 有什么想法吗？？？我现在把它放在 Set jsonBooks = BookInfo(cell).Value 仍然没有运行....

标签： excel vba

【解决方案1】：

@timwilliams - 根据要求使用完整代码重新发布

【讨论】：

我将此标记为 deletion，因为它不是答案。您可以单击“添加评论”以与其他用户交谈而不是发布答案。

【解决方案2】：

像这样：

Sub Tester()

    Dim jsonBooks As Object, auth, authInfo As Object, k
    Dim jsonBook As Object, bookDetails As Object
    Dim ws As Worksheet, isbn, rngIsbn As Range, cell As Range
    
    Set ws = ThisWorkbook.Worksheets("Books")
    
    Set rngIsbn = ws.Range("A1:A5")
    
    For Each cell In rngIsbn
        isbn = cell.Value
        If Len(isbn) > 5 Then
            Set jsonBooks = BookInfo(isbn)
        
            'Note: the aPI only returns `{}` if there's no match to
            '      the ISBN, not (eg) status=404
            If Not jsonBooks Is Nothing Then
                If jsonBooks.Count = 0 Then
                    Debug.Print "No results"
                Else
                    For Each k In jsonBooks
                        Debug.Print "-------" & k & "----------"
                        Set jsonBook = jsonBooks(k)
                        Set bookDetails = jsonBook("details")
                        Debug.Print "Title:", bookDetails("title")
                        Debug.Print "Pub. Date:", bookDetails("publish_date")
                        For Each auth In bookDetails("authors")
                            Debug.Print "Author:", auth("name")
                        Next auth
                    Next k
                  End If
            End If
        End If 'have something to look up
    Next cell

End Sub

Function BookInfo(isbn) As Object
    Dim url As String
    url = "https://openlibrary.org/api/books?bibkeys=ISBN:" & isbn & "&jscmd=details&format=json"
    Set BookInfo = responseObject(url)
End Function

Function responseObject(url As String) As Object
    Dim json As Object, http As Object
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", url, False
        .Send
        'Debug.Print .Status, .responseText
        If .Status = 200 Then
            Set responseObject = JsonConverter.ParseJson(.responseText)
        Else
            Debug.Print .responseText, .Status
        End If
    End With
End Function

【讨论】：