Using VBA to retrieve details from a webpage in Firefox or Chrome

[steback]

Hi All

I was hoping for any assistance with VBA code which can return VAT registration details from HMRC's website.

If you click on the link https://api.service.hmrc.gov.uk/organisations/vat/check-vat-number/lookup/362012792 then you get a valid response as per the attached. By changing the underlined section in the URL then you can check any UK VAT number

What I want to do be able to do is fire the request from VBA and then return the target name, VAT number and address details in to a spreadsheet. If the VAT number is invalid then you get a 'Not Found' response:

Again, I want to bring this back into the spreadsheet. I will then repeat for numerous VAT number. Final result will look like something below:

Any help with this greatly appreciated!

Thanks in advance

Steve

 

[Domenic]

First, if you haven't already done so, download the JSON parser for VBA from the following link, and add it to your project. Note that the file is called JsonConverter.bas. Also, note that you'll need to add a reference to the Microsoft Scripting Runtime library (VBE >> Tools >> Reference).

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

Then, let's assume we start with the following data. For testing purposes, I've included a blank cell, and I've included a couple of URL's that will each cause an error.

steback.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	VAT Number	URL	Response	name	vatNumber	Line1	Line2	Line3	Line4	postcode	countryCode	ProcessingDate	message
2	362012789	www.google.com
3	362012790	https://www.google.com
4	362012791
5	362012792	https://api.service.hmrc.gov.uk/organisations/vat/check-vat-number/lookup/362012792
6	362012793	https://api.service.hmrc.gov.uk/organisations/vat/check-vat-number/lookup/362012793
Sheet1

After running the macro, you'll get the following results . . .

steback.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	VAT Number	URL	Response	name	vatNumber	Line1	Line2	Line3	Line4	postcode	countryCode	ProcessingDate	message
2	362012789	www.google.com	Error										Error -2147012890: The URL does not use a recognized protocol
3	362012790	https://www.google.com	Error										Error: Exptecting a JSON file
4	362012791
5	362012792	https://api.service.hmrc.gov.uk/organisations/vat/check-vat-number/lookup/362012792	Valid	ASDA STORES LIMITED	362012792	ASDA HOUSE	TAXATION DEPARTMENT	SOUTHBANK	GREAT WILSON STREE	LS11 5AD	GB	2022-05-14T02:22:24+01:00
6	362012793	https://api.service.hmrc.gov.uk/organisations/vat/check-vat-number/lookup/362012793	NOT_FOUND										targetVrn does not match a registered company
Sheet1

Here's the code, which needs to be placed in a regular/standard module. Note that it assumes that the sheet containing the URL's is the active sheet. Also, you'll notice that it uses the WinHttpRequest object in order to get the results. Since I have version 5.1, I create an instance of the object using CreateObject("WinHttp.WinHttpRequest.5.1"). However, if your version differs, change the 5.1 bit to the version that you have. You can check for Microsoft WinHttp Services under Tools >> References.

Option Explicit

Sub Get_VAT_Registration_Details()

    On Error Resume Next
    Dim httpRequest As Object
    Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5.1") 'change the 5.1 bit to your latest version
    If httpRequest Is Nothing Then
        MsgBox "Unable to create 'WinHttpRequest' object.", vbCritical
        Exit Sub
    End If
    On Error GoTo 0
   
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row

    Dim rowIndex As Long
    For rowIndex = 2 To lastRow
   
        Dim url As String
        url = Cells(rowIndex, "B").Value
       
        If Len(url) > 0 Then
       
            Dim errorMessage As String
            Dim httpResponse As String
            Dim json As Object
           
            If Not GetHttpRequest(httpRequest, url, httpResponse, errorMessage) Then
           
                If Len(errorMessage) = 0 Then
               
                    Set json = JsonConverter.ParseJson(httpResponse)
                   
                    Cells(rowIndex, "C").Value = json("code")
                    Cells(rowIndex, "M").Value = json("message")
                   
                Else
               
                    Cells(rowIndex, "C").Value = "Error"
                    Cells(rowIndex, "M").Value = errorMessage
                   
                End If
               
            Else
           
                If Left(httpResponse, 1) = "{" Or Left(httpResponse, 1) = "[" Then
           
                    Set json = JsonConverter.ParseJson(httpResponse)
                   
                    Cells(rowIndex, "C").Value = "Valid"
                    Cells(rowIndex, "D").Value = json("target")("name")
                    Cells(rowIndex, "E").Value = json("target")("vatNumber")
                   
                    With json("target")("address")
                        Cells(rowIndex, "F").Value = .Item("line1")
                        Cells(rowIndex, "G").Value = .Item("line2")
                        Cells(rowIndex, "H").Value = .Item("line3")
                        Cells(rowIndex, "I").Value = .Item("line4")
                        Cells(rowIndex, "J").Value = .Item("postcode")
                        Cells(rowIndex, "K").Value = .Item("countryCode")
                    End With
                   
                    Cells(rowIndex, "L").Value = json("processingDate")
                   
                Else
               
                    Cells(rowIndex, "C").Value = "Error"
                    Cells(rowIndex, "M").Value = "Error: Exptecting a JSON file"
               
                End If
               
            End If
           
            httpResponse = ""
            errorMessage = ""
           
        End If
       
    Next rowIndex
   
    MsgBox "Completed!", vbExclamation
   
End Sub

Private Function GetHttpRequest(ByVal httpRequest As Object, ByVal url As String, ByRef httpResponse As String, ByRef errorMessage As String) As Boolean

    On Error GoTo errorHandler
   
    With httpRequest
        .Open "GET", url, False
        .Send
        httpResponse = .ResponseText
        If .Status <> 200 Then
            GetHttpRequest = False
        Else
            GetHttpRequest = True
        End If
    End With
   
exitHandler:
    Exit Function
   
errorHandler:
    GetHttpRequest = False
    errorMessage = "Error " & Err.Number & ": " & Err.Description
    Resume exitHandler

End Function

Hope this helps!

 

[steback]

Hi Domenic - that is superb, thanks so much for such a comprehensive response!

 

[steback]

As a follow up question, if I have the JSON converter module in an addin as part of other code then do you if that would work for other users without them taking any additional action?

 

[Domenic]

In that case, I would use the serverXMLHTTP object instead of WinHttpRequest, so that you won't have to worry about users having different versions. Also, I would add some additional error handling. I would check to make sure that a worksheet is active before proceeding, and that the worksheet is a valid one by making sure that cell A1 contains the header "VAT Number" and B1 contains "URL". Accordingly, the code can be amended as follows . . .

Sub Get_VAT_Registration_Details()

    On Error Resume Next
    Dim httpRequest As Object
    Set httpRequest = CreateObject("MSXML2.serverXMLHTTP")
    If httpRequest Is Nothing Then
        MsgBox "Unable to create the 'serverXMLHTTP' object.", vbCritical
        Exit Sub
    End If
    On Error GoTo 0
    
    If TypeName(ActiveSheet) <> "Worksheet" Then
        MsgBox "No worksheet found!", vbExclamation
        Exit Sub
    End If
    
    If LCase(Range("A1").Value) <> "vat number" Or LCase(Range("B1").Value) <> "url" Then
        MsgBox "Worksheet is invalid!", vbExclamation
        Exit Sub
    End If
    
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row

    Dim rowIndex As Long
    For rowIndex = 2 To lastRow
    
        Dim url As String
        url = Cells(rowIndex, "B").Value
        
        If Len(url) > 0 Then
        
            Dim errorMessage As String
            Dim httpResponse As String
            Dim json As Object
            
            If Not GetHttpRequest(httpRequest, url, httpResponse, errorMessage) Then
            
                If Len(errorMessage) = 0 Then
                
                    Set json = JsonConverter.ParseJson(httpResponse)
                    
                    Cells(rowIndex, "C").Value = json("code")
                    Cells(rowIndex, "M").Value = json("message")
                    
                Else
                
                    Cells(rowIndex, "C").Value = "Error"
                    Cells(rowIndex, "M").Value = errorMessage
                    
                End If
                
            Else
            
                If Left(httpResponse, 1) = "{" Or Left(httpResponse, 1) = "[" Then
            
                    Set json = JsonConverter.ParseJson(httpResponse)
                    
                    Cells(rowIndex, "C").Value = "Valid"
                    Cells(rowIndex, "D").Value = json("target")("name")
                    Cells(rowIndex, "E").Value = json("target")("vatNumber")
                    
                    With json("target")("address")
                        Cells(rowIndex, "F").Value = .Item("line1")
                        Cells(rowIndex, "G").Value = .Item("line2")
                        Cells(rowIndex, "H").Value = .Item("line3")
                        Cells(rowIndex, "I").Value = .Item("line4")
                        Cells(rowIndex, "J").Value = .Item("postcode")
                        Cells(rowIndex, "K").Value = .Item("countryCode")
                    End With
                    
                    Cells(rowIndex, "L").Value = json("processingDate")
                    
                Else
                
                    Cells(rowIndex, "C").Value = "Error"
                    Cells(rowIndex, "M").Value = "Error: Exptecting a JSON file"
                
                End If
                
            End If
            
            httpResponse = ""
            errorMessage = ""
            
        End If
        
    Next rowIndex
    
    MsgBox "Completed!", vbExclamation
    
End Sub

Hope this helps!