Get information from API using VBA

K

K1600

Board Regular
Joined
Oct 20, 2017
Messages
190
Office Version
  1. 365
Platform
  1. Windows
I am trying to pull information from an API but I can't work out how to do the coding.

I have been provided the below in relation to the API and I have my API key to add in but would appreciate it if someone could assist with how I need to code it.

curl -H "Accept: application/json" -H "x-api-key: your_api_key" \https://beta.check-mot.service.gov.uk/trade/vehicles/mot-tests\?registration=XX10ABC

Once I have managed to master this bit it is my intention to integrate this into my existing code in order to pull the registration number out from a table and then return the MOT test date from the API which appears to be referenced as "completedDate".

Thanks in advance.
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
See if this gets you started, though untested because I don't have an API key for this:
dvsa.github.io

MOT history API - Documentation

dvsa.github.io dvsa.github.io

VBA Code: 
Public Sub XMLhttp_MOT_Check()

    Const APIkey = "YOUR API KEY"
    
    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")

    Dim rootURL As String, registrationEndpointURL As String
    Dim registration As String
    
    rootURL = "https://beta.check-mot.service.gov.uk"
    
    registration = "XX10ABC"
    registrationEndpointURL = rootURL & "/trade/vehicles/mot-tests?registration=" & registration
    
    With httpReq
        .Open "GET", registrationEndpointURL, False
        .setRequestHeader "Accept", "application/json+v6"
        .setRequestHeader "x-api-key", APIkey
        .send
        Debug.Print .Status, .statusText
        Debug.Print .responseText
    End With
    
End Sub
The Debug output is shown in the VBA Immediate Window. If the request is valid the responseText contains the JSON response string and you can parse this string for the "completedDate" values. I recommend parsing it with the VBA-JSON JsonConverter module at:

github.com

GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA

JSON conversion and parsing for VBA. Contribute to VBA-tools/VBA-JSON development by creating an account on GitHub.
github.com github.com
 
Upvote 0
John_w said:
See if this gets you started, though untested because I don't have an API key for this:
dvsa.github.io

MOT history API - Documentation

dvsa.github.io dvsa.github.io

VBA Code: 
Public Sub XMLhttp_MOT_Check()

    Const APIkey = "YOUR API KEY"
   
    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")

    Dim rootURL As String, registrationEndpointURL As String
    Dim registration As String
   
    rootURL = "https://beta.check-mot.service.gov.uk"
   
    registration = "XX10ABC"
    registrationEndpointURL = rootURL & "/trade/vehicles/mot-tests?registration=" & registration
   
    With httpReq
        .Open "GET", registrationEndpointURL, False
        .setRequestHeader "Accept", "application/json+v6"
        .setRequestHeader "x-api-key", APIkey
        .send
        Debug.Print .Status, .statusText
        Debug.Print .responseText
    End With
   
End Sub
The Debug output is shown in the VBA Immediate Window. If the request is valid the responseText contains the JSON response string and you can parse this string for the "completedDate" values. I recommend parsing it with the VBA-JSON JsonConverter module at:

github.com

GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA

JSON conversion and parsing for VBA. Contribute to VBA-tools/VBA-JSON development by creating an account on GitHub.
github.com github.com
Click to expand...
Hi John, thanks for the reply, that works great.

I am just struggling to work out a way to get the information from the json as it doesn't look like I will be able to use the GitHub solution as our work computers won't let me install anything to them due to the security settings. Is there a way to pull it out without? I only really need the date of the last test and if it passed or failed (the bits in red/bold/underlined below). It is pulled the result into the immediate window so it's definitely worked but obviously it's the full string.

The returned string is:

200
[{"registration":"XX10ABC","make":"LAND ROVER","model":"RANGE ROVER","firstUsedDate":"2014.03.01","fuelType":"Petrol","primaryColour":"Black","vehicleId":"Lu0QQjYE4uSd-ANBeTRXbA==","registrationDate":"2014.03.01","manufactureDate":"2014.03.01","engineSize":"4999","motTests":[{"completedDate":"2020.02.29 12:19:35","testResult":"PASSED","expiryDate":"2021.02.28","odometerValue":"20979","odometerUnit":"mi","motTestNumber":"505543558510","odometerResultType":"READ","rfrAndComments":[]},{"completedDate":"2019.02.13 12:00:08","testResult":"PASSED","expiryDate":"2020.02.28","odometerValue":"18779","odometerUnit":"mi","motTestNumber":"231019448972","odometerResultType":"READ","rfrAndComments":[]},{"completedDate":"2018.02.08 15:01:11","testResult":"PASSED","expiryDate":"2019.02.28","odometerValue":"15450","odometerUnit":"mi","motTestNumber":"189750419477","odometerResultType":"READ","rfrAndComments":[]},{"completedDate":"2017.02.21 10:55:01","testResult":"PASSED","expiryDate":"2018.02.28","odometerValue":"12055","od
ometerUnit":"mi","motTestNumber":"490394149614","odometerResultType":"READ","rfrAndComments":[]}]}]
 
Upvote 0
K1600

You don't need to install anything to use VBA-JSON.

All you need to do is download JsonConverter.bas and then import it into an Excel workbook.
 
Upvote 0
Norie said:
K1600

You don't need to install anything to use VBA-JSON.

All you need to do is download JsonConverter.bas and then import it into an Excel workbook.
Click to expand...
Thanks for that Norie, I thought it was going to be an install rather than an import.

I have done that but I can't get it to return the result despite following the video on the site. Am I missing something or have I got something wrong?

VBA Code: 
Public Sub XMLhttp_MOT_Check()

    Const APIkey = "MY API KEY"
   
    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")
    Dim Response As Variant     'TEST LINE

    Dim rootURL As String, registrationEndpointURL As String
    Dim registration As String
   
    rootURL = "https://beta.check-mot.service.gov.uk"
   
    registration = "XX10ABC"
    registrationEndpointURL = rootURL & "/trade/vehicles/mot-tests?registration=" & registration
   
Dim Json As Object
Set Json = JsonConverter.ParseJson(Response)
   
    With httpReq
        .Open "GET", registrationEndpointURL, False
        .setRequestHeader "Accept", "application/json+v6"
        .setRequestHeader "x-api-key", APIkey
        .send
        Debug.Print .Status, .StatusText
        Debug.Print .responseText
        Response = .responseText
'        MsgBox (Response)
        MsgBox Json("completedDate")  ' "completedDate" is the name of the required field
    End With

It runs without issue when just returning the data to a MsgBox but when I add the three extra lines of code:

Code: 
Dim Json As Object
Set Json = JsonConverter.ParseJson(Response)


MsgBox Json("completedDate")

I initially got an error which when I debugged took me to MsgBox Json("completedDate") but I'm not sure what the error was as I can't replicate it now but I am now getting:

"Run-time error '10001':
Error parsing JSON

Expecting '{' or '['

If I debug this it takes me to Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(JsonString, json_Index, "Expecting '{' or '['") in the JsonConverter coding module.

I was wondering if it was that I needed to specify a deeper level of field name rather than just "completedDate" but I can't work out what my level names are.

Hopefully that makes some kind of sense.
 
Last edited:
Upvote 0
Your call to ParseJson is too soon and its argument should be the .responseText result of the XMLhttp call. Try this:

VBA Code: 
Public Sub XMLhttp_MOT_Check()

    Const APIkey = "YOUR API KEY HERE"
   
    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")
   
    Dim rootURL As String, registrationEndpointURL As String
    Dim registration As String
    Dim JSON As Object
   
    rootURL = "https://beta.check-mot.service.gov.uk"
   
    registration = "XX10ABC"
    registrationEndpointURL = rootURL & "/trade/vehicles/mot-tests?registration=" & registration
   
    With httpReq
        .Open "GET", registrationEndpointURL, False
        .setRequestHeader "Accept", "application/json+v6"
        .setRequestHeader "x-api-key", APIkey
        .send
        Debug.Print .Status, .statusText
        Debug.Print .responseText
        Set JSON = JsonConverter.ParseJson(.responseText)
    End With

    Dim completedDateValue As String, completedDate As Date, testResult As String
   
    completedDateValue = JSON(1)("motTests")(1)("completedDate")
    completedDate = DateSerial(Mid(completedDateValue, 1, 4), Mid(completedDateValue, 6, 2), Mid(completedDateValue, 9, 2)) 'date only
    testResult = JSON(1)("motTests")(1)("testResult")
    MsgBox completedDate & " " & testResult
       
End Sub
JsonConverter might be overkill if you only need to extract 2 values, in which case the same thing can be done with VBA Instr and Mid functions.
 
Upvote 0
John_w said:
Your call to ParseJson is too soon and its argument should be the .responseText result of the XMLhttp call. Try this:

VBA Code: 
Public Sub XMLhttp_MOT_Check()

    Const APIkey = "YOUR API KEY HERE"
  
    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")
  
    Dim rootURL As String, registrationEndpointURL As String
    Dim registration As String
    Dim JSON As Object
  
    rootURL = "https://beta.check-mot.service.gov.uk"
  
    registration = "XX10ABC"
    registrationEndpointURL = rootURL & "/trade/vehicles/mot-tests?registration=" & registration
  
    With httpReq
        .Open "GET", registrationEndpointURL, False
        .setRequestHeader "Accept", "application/json+v6"
        .setRequestHeader "x-api-key", APIkey
        .send
        Debug.Print .Status, .statusText
        Debug.Print .responseText
        Set JSON = JsonConverter.ParseJson(.responseText)
    End With

    Dim completedDateValue As String, completedDate As Date, testResult As String
  
    completedDateValue = JSON(1)("motTests")(1)("completedDate")
    completedDate = DateSerial(Mid(completedDateValue, 1, 4), Mid(completedDateValue, 6, 2), Mid(completedDateValue, 9, 2)) 'date only
    testResult = JSON(1)("motTests")(1)("testResult")
    MsgBox completedDate & " " & testResult
      
End Sub
JsonConverter might be overkill if you only need to extract 2 values, in which case the same thing can be done with VBA Instr and Mid functions.
Click to expand...
Thanks again for your help John, it really is appreciated.

I have amended the coding as you suggested and it is working great, I have jsut come a bit unstuck doing what I thought I was going to be ok with. I have tried to now just amalgamate my code for the selection of the VRM and then the placing of the result into a loop. I need it to pick it from "Table8" in worksheet "Pro" which has headers. I've added most of the code for referencing the headers I think but I can't fathom how to get the VRM to select from the VRM column and how to then set the loop to do the remaining rows in the list before it putting the results in the relevant columns of Last MOT (date), Result & Odo.

Could I possibly impose on you for a bit more help. I currently have this:

VBA Code: 
Public Sub Test_MOT_Check()

    Dim rngColLastMOT As Range
    Dim rngColVRM As Range
    Dim rngColResult As Range
    Dim rngColOdo As Range
    Dim ws As Worksheet
    Set ws = Worksheets("Pro")
    Set rngColVRM = ws.Range("Table8[VRM / ID]")            'Sets the column header name
    Set rngColLastMOT = ws.Range("Table8[Last MOT Date]")   'Sets the column header name
    Set rngColLastMOT = ws.Range("Table8[Result]")   'Sets the column header name
    Set rngColOdo = ws.Range("Table8[Odometer]")         'Sets the column header name

    Const APIkey = "MY API KEY"
    
    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")

    Dim rootURL As String, registrationEndpointURL As String
    Dim registration As String
    Dim JSON
    
    rootURL = "https://beta.check-mot.service.gov.uk"
    
    registration = "XX10ABC"
    registrationEndpointURL = rootURL & "/trade/vehicles/mot-tests?registration=" & registration
    
    With httpReq
        .Open "GET", registrationEndpointURL, False
        .setRequestHeader "Accept", "application/json+v6"
        .setRequestHeader "x-api-key", APIkey
        .send
        Debug.Print .Status, .StatusText
        Debug.Print .responseText
        Set JSON = JsonConverter.ParseJson(.responseText)
    End With
    
    Dim completedDateValue As String, completedDate As Date, testResult As String, odometerValue As String
    
    completedDateValue = JSON(1)("motTests")(1)("completedDate")
    completedDate = DateSerial(Mid(completedDateValue, 1, 4), Mid(completedDateValue, 6, 2), Mid(completedDateValue, 9, 2)) 'date only
    testResult = JSON(1)("motTests")(1)("testResult")
    odometerValue = JSON(1)("motTests")(1)("odometerValue")
    
    MsgBox completedDate & " " & testResult & " " & odometerValue

End Sub
 
Upvote 0
The loop needed is similar to your other thread for looping through the rows in a table column. Try this:
VBA Code: 
Public Sub Test_MOT_Check()

    Const APIkey = "MY API KEY"
    
    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")
    
    Dim rngColLastMOT As Range
    Dim rngColVRM As Range
    Dim rngColResult As Range
    Dim rngColOdo As Range
    Dim rootURL As String, registrationEndpointURL As String
    Dim r As Long
    Dim JSON As Object
    Dim completedDateValue As String, completedDate As Date, testResult As String, odometerValue As String
    
    With Worksheets("Pro")
        Set rngColVRM = .Range("Table8[VRM / ID]")          'Sets the column header name
        Set rngColLastMOT = .Range("Table8[Last MOT Date]")
        Set rngColResult = .Range("Table8[Result]")
        Set rngColOdo = .Range("Table8[Odometer]")
    End With
    
    rootURL = "https://beta.check-mot.service.gov.uk"
    registrationEndpointURL = rootURL & "/trade/vehicles/mot-tests?registration="
    
    For r = 1 To rngColVRM.Rows.Count
       
        With httpReq
            .Open "GET", registrationEndpointURL & rngColVRM.cells(r).Value, False
            .setRequestHeader "Accept", "application/json+v6"
            .setRequestHeader "x-api-key", APIkey
            .send
            Set JSON = JsonConverter.ParseJson(.responseText)
        End With
        
        completedDateValue = JSON(1)("motTests")(1)("completedDate")
        completedDate = DateSerial(Mid(completedDateValue, 1, 4), Mid(completedDateValue, 6, 2), Mid(completedDateValue, 9, 2)) 'date only
        testResult = JSON(1)("motTests")(1)("testResult")
        odometerValue = JSON(1)("motTests")(1)("odometerValue")
        
        rngColLastMOT.cells(r).Value = completedDate
        rngColResult.cells(r).Value = testResult
        rngColOdo.cells(r).Value = odometerValue
    
    Next
    
End Sub
 
Upvote 0
John_w said:
The loop needed is similar to your other thread for looping through the rows in a table column. Try this:
VBA Code: 
Public Sub Test_MOT_Check()

    Const APIkey = "MY API KEY"
   
    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")
   
    Dim rngColLastMOT As Range
    Dim rngColVRM As Range
    Dim rngColResult As Range
    Dim rngColOdo As Range
    Dim rootURL As String, registrationEndpointURL As String
    Dim r As Long
    Dim JSON As Object
    Dim completedDateValue As String, completedDate As Date, testResult As String, odometerValue As String
   
    With Worksheets("Pro")
        Set rngColVRM = .Range("Table8[VRM / ID]")          'Sets the column header name
        Set rngColLastMOT = .Range("Table8[Last MOT Date]")
        Set rngColResult = .Range("Table8[Result]")
        Set rngColOdo = .Range("Table8[Odometer]")
    End With
   
    rootURL = "https://beta.check-mot.service.gov.uk"
    registrationEndpointURL = rootURL & "/trade/vehicles/mot-tests?registration="
   
    For r = 1 To rngColVRM.Rows.Count
      
        With httpReq
            .Open "GET", registrationEndpointURL & rngColVRM.cells(r).Value, False
            .setRequestHeader "Accept", "application/json+v6"
            .setRequestHeader "x-api-key", APIkey
            .send
            Set JSON = JsonConverter.ParseJson(.responseText)
        End With
       
        completedDateValue = JSON(1)("motTests")(1)("completedDate")
        completedDate = DateSerial(Mid(completedDateValue, 1, 4), Mid(completedDateValue, 6, 2), Mid(completedDateValue, 9, 2)) 'date only
        testResult = JSON(1)("motTests")(1)("testResult")
        odometerValue = JSON(1)("motTests")(1)("odometerValue")
       
        rngColLastMOT.cells(r).Value = completedDate
        rngColResult.cells(r).Value = testResult
        rngColOdo.cells(r).Value = odometerValue
   
    Next
   
End Sub
Click to expand...
It was the coding from my other thread that I was trying to combine with this but I got a bit mixed up.

I've updated it as per the code you kindly did but I'm getting a run-time error 13 - Type mismatch on this section:

VBA Code: 
        completedDateValue = JSON(1)("motTests")(1)("completedDate")
        completedDate = DateSerial(Mid(completedDateValue, 1, 4), Mid(completedDateValue, 6, 2), Mid(completedDateValue, 9, 2)) 'date only
        testResult = JSON(1)("motTests")(1)("testResult")
        odometerValue = JSON(1)("motTests")(1)("odometerValue")

This is the full code as it is now (the named headers for the columns have changed slightly due to a tweak on the spreadsheet but they are still correct against the headers in the table):

Code: 
Public Sub Test_MOT_Check()

    Const APIkey = "MY API KEY"
    
    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")

    Dim rngColLastMOT As Range
    Dim rngColVRM As Range
    Dim rngColResult As Range
    Dim rngColMOTOdo As Range
    Dim rootURL As String, registrationEndpointURL As String
    Dim r As Long
    Dim JSON As Object
    Dim completedDateValue As String, completedDate As Date, testResult As String, odometerValue As String
    
    With Worksheets("Pro")
        Set rngColVRM = .Range("Table8[VRM / ID]")
        Set rngColLastMOT = .Range("Table8[Last MOT Date]")
        Set rngColResult = .Range("Table8[MOT Test Result]")
        Set rngColMOTOdo = .Range("Table8[MOT Odometer]")
    End With
    
    rootURL = "https://beta.check-mot.service.gov.uk"
    registrationEndpointURL = rootURL & "/trade/vehicles/mot-tests?registration="
    
    For r = 1 To rngColVRM.Rows.Count
        
        With httpReq
            .Open "GET", registrationEndpointURL & rngColVRM.Cells(r).Value, False
            .setRequestHeader "Accept", "application/json+v6"
            .setRequestHeader "x-api-key", APIkey
            .send
            Set JSON = JsonConverter.ParseJson(.responseText)
        End With
    
        completedDateValue = JSON(1)("motTests")(1)("completedDate")
        completedDate = DateSerial(Mid(completedDateValue, 1, 4), Mid(completedDateValue, 6, 2), Mid(completedDateValue, 9, 2)) 'date only
        testResult = JSON(1)("motTests")(1)("testResult")
        odometerValue = JSON(1)("motTests")(1)("odometerValue")
    
        rngColLastMOT.Cells(r).Value = completedDate
        rngColResult.Cells(r).Value = testResult
        rngColMOTOdo.Cells(r).Value = odometerValue

    Next

End Sub

Thanks again for your help.

Glynn
 
Upvote 0
Exactly which line is causing the error? Click Debug on the error message and the errant line is highlighted in yellow.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
How do I write Code for an API key call using Blank Query on legacy Excel/Mac
Replies
1
Views
57
Ron de Bruin
Ron de Bruin
F
  • Solved
Calculate Travel Time and Distance using Google Maps API
Replies
3
Views
5K
Jon Peltier
J
E
  • Solved
Json Excel Square Brackets within Square Brackets Run-Time Error '1004'
Replies
3
Views
872
Domenic
D
I
  • Question Question
Show the "Edit Name" dialog from VBA for a specific Name
Replies
1
Views
883
Jaafar Tribak
Jaafar Tribak
P
  • Question Question
Make an api call to geoTab to get current location of the vehicle in VBA. Tried few codes but nothing seem to work. Any help is appreciated.
Replies
0
Views
1K
Pardeep Singh
P

Forum statistics

Threads
1,224,823
Messages
6,181,179
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top