Excel - bbdd biblioteca

Sub Macro2()

'

' Macro2 Macro

'

' Acceso directo: CTRL+q

'

'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")

Sheets(1).Cells(i, ActiveCell.Column + 5).Value = subItem("publisher")

'To Obtain authors

 Set subItem = item("volumeInfo")

        If subItem.Exists("authors") Then

            r = r + 1: co = 1

            For Each item2 In subItem("authors")

                Sheets(1).Cells(i, ActiveCell.Column + 6).Value = item2 & ";" & Sheets(1).Cells(i, ActiveCell.Column + 6).Value

                co = co + 1

            Next

        End If

'To obtain ISBN-10 and ISBN-13

j = 7

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