Get information from API using VBA

K1600

Board Regular
Joined
Oct 20, 2017
Messages
166
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.
 

K1600

Board Regular
Joined
Oct 20, 2017
Messages
166
Exactly which line is causing the error? Click Debug on the error message and the errant line is highlighted in yellow.
Debug is taking me to:
completedDateValue = JSON(1)("motTests")(1)("completedDate")
 

Some videos you may like

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,716
What status is the request returning? Reinstate the Debug.Print .Status, .statusText to find out.

Assuming the request is valid, the API says it returns:

200 - OK : Your request was serviced
404 - resource not found : Vehicle with the provided parameters was not found or its test records are not valid

All the code posted so far assumes a status of 200.
 

K1600

Board Regular
Joined
Oct 20, 2017
Messages
166
What status is the request returning? Reinstate the Debug.Print .Status, .statusText to find out.

Assuming the request is valid, the API says it returns:

200 - OK : Your request was serviced
404 - resource not found : Vehicle with the provided parameters was not found or its test records are not valid

All the code posted so far assumes a status of 200.
I've just sussed it, it's because one of the VRM's I added to the list is for a vehicle less than 3 years old so it hasn't had it's first MOT yet. I changed the VRM to an older vehicle and it works fine.

If the above scenario happens, then I would just want the MOT date field to remain blank. I have just tried adding an 'on error' as below but this returns "12:00:00 AM" in the MOT date field on the table.

VBA Code:
    On Error Resume Next
        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")
    On Error GoTo 0
 

K1600

Board Regular
Joined
Oct 20, 2017
Messages
166
Thinking about it, it could be something to do with the conversion of the date as with the on error code in it leaves the result and odometer fields blank just puts the time in the date field.
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,716

ADVERTISEMENT

It's better to check the status rather than handle the error:
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 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
            Debug.Print .Status, .statusText
            Debug.Print .responseText
            Set JSON = JsonConverter.ParseJson(.responseText)
    
            If .Status = 200 Then
                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
            End If

        End With

    Next

End Sub
 

K1600

Board Regular
Joined
Oct 20, 2017
Messages
166
It's better to check the status rather than handle the error:
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 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
            Debug.Print .Status, .statusText
            Debug.Print .responseText
            Set JSON = JsonConverter.ParseJson(.responseText)
   
            If .Status = 200 Then
                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
            End If

        End With

    Next

End Sub
That makes a lot of sense. My computer has just decided it's doing an update so I'll give that a whirl in the morning.

Thanks again for all your help, it really is appreciated.
 

K1600

Board Regular
Joined
Oct 20, 2017
Messages
166

ADVERTISEMENT

It's better to check the status rather than handle the error:
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 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
            Debug.Print .Status, .statusText
            Debug.Print .responseText
            Set JSON = JsonConverter.ParseJson(.responseText)
   
            If .Status = 200 Then
                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
            End If

        End With

    Next

End Sub
That hasn't worked because it still returns a 200 response and gives the rest of the vehicle details even if the vehicle hasn't had it's first MOT.

If you run the check on a vehicle which hasn't had it's first MOT this is the data which is returned:

200
[{"registration":"MX19JUE","make":"BMW","model":"X5","manufactureYear":"2019","fuelType":"Diesel","primaryColour":"White","dvlaId":"172153631","registrationDate":"2019.06.01","manufactureDate":"2019.06.01","engineSize":"2993","motTestDueDate":"2022-05-31"}]

It seems to only list the headers for something it has a result for so my "completedDate" is missing in this one.
 

K1600

Board Regular
Joined
Oct 20, 2017
Messages
166
I just worked out that if there is a space in the registration in the VRM field then it is returning a 404 response. Is there a way of removing the space (if there is one) in the VRM field within the code before it uses it or will I need to sort this in the master data?
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,716
This code should fix both issues:
VBA Code:
Public Sub Test_MOT_Check2()

    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 & Trim(rngColVRM.cells(r).Value), False
            .setRequestHeader "Accept", "application/json+v6"
            .setRequestHeader "x-api-key", APIkey
            .send
            Debug.Print .Status, .statusText
            Debug.Print .responseText
            Set JSON = JsonConverter.ParseJson(.responseText)
    
            If .Status = 200 Then
                If JSON(1).Exists("motTests") Then
                    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
                End If
            End If

        End With

    Next

End Sub
 

K1600

Board Regular
Joined
Oct 20, 2017
Messages
166
This code should fix both issues:
VBA Code:
Public Sub Test_MOT_Check2()

    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 & Trim(rngColVRM.cells(r).Value), False
            .setRequestHeader "Accept", "application/json+v6"
            .setRequestHeader "x-api-key", APIkey
            .send
            Debug.Print .Status, .statusText
            Debug.Print .responseText
            Set JSON = JsonConverter.ParseJson(.responseText)
   
            If .Status = 200 Then
                If JSON(1).Exists("motTests") Then
                    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
                End If
            End If

        End With

    Next

End Sub
That seems to have resolved the issue if the vehicle hasn't had it's first MOT but the Trim bit isn't working to remove the space from the VRM. Looking at the 404 error that it returns (as below) it isn't removing the space as the error lists the VRM with the space included.

404
{ "httpStatus": "404", "errorMessage": "No MOT Tests found with vehicle registration : KN62 WZN", "awsRequestId": "2c39de48-30b6-4fca-a2f4-2a459e9887a7"}
 

Watch MrExcel Video

Forum statistics

Threads
1,127,784
Messages
5,626,850
Members
416,205
Latest member
rondon

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
Top