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.
 
Sort by date Sort by votes
John_w said:
Exactly which line is causing the error? Click Debug on the error message and the errant line is highlighted in yellow.
Click to expand...
Debug is taking me to:
completedDateValue = JSON(1)("motTests")(1)("completedDate")
 
Upvote 0

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
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.
 
Upvote 0
John_w said:
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.
Click to expand...
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
John_w said:
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
Click to expand...
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.
 
Upvote 0
John_w said:
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
Click to expand...
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.
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
John_w said:
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
Click to expand...
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"}
 
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
58
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,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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