Home » excel » excel – VAT number check not working after I update the taxation link

excel – VAT number check not working after I update the taxation link

Posted by: admin April 23, 2020 Leave a comment

Questions:

I found this VBA code to check VAT number via Excel. But the link that they used in the code doesn’t work anymore, and needs to be adjusted to this link http://ec.europa.eu/taxation_customs/vies/?locale=be

But if I change the link, I also need to change other elements. Unfortunately I am still a beginner with regards to coding. Does anyone know what I need to change in order to get the following?

VatNumberCheckExcel

The vba code is currently this:

Sub test()
    Dim lrow As Long, data, obj As Object, i As Long, country, VATnum, webreply As String

    lrow = Cells(Rows.Count, 1).End(xlUp).Row
    If lrow = 1 Then Exit Sub

    If Range("a1") <> "VAT" Then Exit Sub

    data = Range("a1:d" & lrow)

    Set obj = CreateObject("MSXML2.XMLHTTP")

    For i = 2 To lrow
        If Len(data(i, 1)) > 2 Then
            country = Left(data(i, 1), 2)
            VATnum = Right(data(i, 1), Len(data(i, 1)) - 2)
            obj.Open "GET", "http://vatid.eu/check/" & country & "/" & VATnum & "/" & country & "/" & VATnum
            obj.send
            Do: DoEvents: Loop Until obj.ReadyState = 4
            webreply = obj.responsetext
            If InStr(webreply, "<error>") > 0 Then
                data(i, 2) = False
            Else
                data(i, 2) = Split(Split(webreply, "<valid>")(1), "</valid>")(0)
                data(i, 3) = Split(Split(webreply, "<name><![CDATA[")(1), "]]></name>")(0)
                data(i, 4) = Split(Split(webreply, "<address><![CDATA[")(1), "]]></address>")(0)
            End If
        End If
    Next

    obj.abort

    Range("a1:d" & lrow) = data

End Sub





Public Function VAT(rng As Range) As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://vatid.eu/check/" & Left(rng, 2) & "/" & Right(rng, Len(rng) - 2)
        .send
        Do: DoEvents: Loop Until .ReadyState = 4
        VAT = Split(Split(.responsetext, "<valid>")(1), "</valid>")(0)
        .abort
    End With
End Function
How to&Answers:

The below seems to work for me, but you might need to change "Sheet1" to the name of the sheet where your data is located.

Option Explicit

Private Sub VerifyEUVatNumbers()

    Const EU_VIES_API_ENDPOINT As String = "http://ec.europa.eu/taxation_customs/vies/services/checkVatService"

    ' Change this to whatever your worksheet is called. I assume Sheet1
    With ThisWorkbook.Worksheets("Sheet1")

        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        .Range("B2:D" & lastRow).ClearContents ' Clear results from last time code was run

        Dim euVATnumbersToCheck() As Variant
        euVATnumbersToCheck = .Range("A2:D" & lastRow).Value2

        Dim countryCode As String
        Dim vatNumber As String
        Dim envelopeToSend As String
        Dim rowIndex As Long

        Dim webClient As MSXML2.ServerXMLHTTP60
        Set webClient = New MSXML2.ServerXMLHTTP60

        With webClient
            For rowIndex = LBound(euVATnumbersToCheck, 1) To UBound(euVATnumbersToCheck, 1)
                countryCode = VBA.Strings.Left$(euVATnumbersToCheck(rowIndex, 1), 2)
                vatNumber = VBA.Strings.Mid$(euVATnumbersToCheck(rowIndex, 1), 3)
                envelopeToSend = soapEnvelope(countryCode, vatNumber)

                .Open "POST", EU_VIES_API_ENDPOINT, True
                .send envelopeToSend
                .waitForResponse

                euVATnumbersToCheck(rowIndex, 2) = TextBetweenTwoDelimiters(.responseText, "<valid>", "</valid>")
                euVATnumbersToCheck(rowIndex, 3) = TextBetweenTwoDelimiters(.responseText, "<name>", "</name>")
                euVATnumbersToCheck(rowIndex, 4) = TextBetweenTwoDelimiters(.responseText, "<address>", "</address>")
                euVATnumbersToCheck(rowIndex, 4) = VBA.Strings.Replace(euVATnumbersToCheck(rowIndex, 4), VBA.Strings.Chr$(10), ", ", 1, -1, vbBinaryCompare)
            Next rowIndex
        End With

        .Range("A2").Resize(UBound(euVATnumbersToCheck, 1), UBound(euVATnumbersToCheck, 2)).Value2 = euVATnumbersToCheck

    End With
End Sub

Public Function TextBetweenTwoDelimiters(ByVal textToParse As String, ByVal firstDelimiter As String, ByVal secondDelimiter As String) as String
    Dim firstDelimiterIndex As Long
    firstDelimiterIndex = VBA.Strings.InStr(1, textToParse, firstDelimiter, vbBinaryCompare)

    If firstDelimiterIndex = 0 Then
        Exit Function
    Else
        firstDelimiterIndex = firstDelimiterIndex + Len(firstDelimiter) ' Assume we don't delimiter included
    End If

    Dim secondDelimiterIndex As Long
    secondDelimiterIndex = VBA.Strings.InStr(firstDelimiterIndex, textToParse, secondDelimiter, vbBinaryCompare)

    If secondDelimiterIndex = 0 Then
        Exit Function
    Else
        secondDelimiterIndex = secondDelimiterIndex ' Assume we don't delimiter included
    End If

    TextBetweenTwoDelimiters = VBA.Strings.Mid$(textToParse, firstDelimiterIndex, secondDelimiterIndex - firstDelimiterIndex)
End Function

Private Function soapEnvelope(ByVal countryCode As String, ByVal vatNumber As String) As String
    ' Give this function a country code and VAT Number.
    ' It will return an envelope that can be sent in the request's body

    Dim outputEnvelope As String
    outputEnvelope = "<s11:Envelope xmlns:s11='http://schemas.xmlsoap.org/soap/envelope/'>" & _
                "<s11:Body>" & _
                    "<tns1:checkVat xmlns:tns1='urn:ec.europa.eu:taxud:vies:services:checkVat:types'>" & _
                        "<tns1:countryCode>" & countryCode & "</tns1:countryCode>" & _
                        "<tns1:vatNumber>" & vatNumber & "</tns1:vatNumber>" & _
                    "</tns1:checkVat>" & _
                "</s11:Body>" & _
            "</s11:Envelope>"

    soapEnvelope = outputEnvelope
End Function

Some things to note:

  • I took the SOAP envelope from one of the existing PHP implementations
    on GitHub (I’ve since closed that particular browser tab, otherwise
    would include the link in my answer).
  • Instead of parsing server’s
    response as an XML document, I just parse it as a string (not good,
    but the returned resource is pretty small).
  • Code assumes
    everything will be successful. If the request times out or an
    error message is returned, the code will likely throw an error (if it does not know how to handle it)
  • From the technical resources/documentation available on the EC’s own website
    (e.g. WSDL and FAQ), it seems that there is no central
    database (your request goes to their server, then their server
    requests the information from the relevant country/member state’s
    database).
  • The usual quota/usage stipulations (governing the consumption of
    any service/API) are in place. If they receive too many requests from
    a given IP within a short space of time or too many requests which
    yield invalid EU VAT numbers, they may suspect misuse of their service and blacklist
    your IP.

This is what I start off with:

Before

This is what I get after the code:

After

Answer:

Largely based on this answer. Only changed the NextSibling part to getting the x’th td tag:

Sub getData()

'~~~~Variable declaration~~~~'
Dim IE As Object
Dim country As Object
Dim num As Object
Dim btn As Object
Dim tlb As Object, td As Object

Set IE = CreateObject("InternetExplorer.Application")

IE.Visible = False
IE.navigate "http://ec.europa.eu/taxation_customs/vies/?locale=en"

'Wait till page is loaded
Do While IE.readystate <> 4
    DoEvents
Loop


Set country = IE.document.getElementById("countryCombobox")
country.Value = "FR" 'set the value for Member state


'Pause the code for 1 sec
Application.Wait Now + TimeSerial(0, 0, 1)

'
Set num = IE.document.getElementById("number")
num.Value = "27435044714" 'set the Vat number


Application.Wait Now + TimeSerial(0, 0, 1)


Set btn = IE.document.getElementById("submit")
btn.Click ' click the verify button

'Wait till page is loaded
Do While IE.readystate <> 4: DoEvents: Loop

'Pause the code for 5 sec
    Application.Wait Now + TimeSerial(0, 0, 5)

    Set tbl = IE.document.getElementById("vatResponseFormTable")

    numb_spans = tbl.getElementsByTagName("td").Length
    MsgBox (tbl.getElementsByTagName("td")(0).innerText)
    pos = InStr(1, tbl.getElementsByTagName("td")(0).innerText, "valid VAT")
    If pos > 0 Then
        Cells(2, 2) = True
        Cells(2, 3) = tbl.getElementsByTagName("td")(10).innerText
        Cells(2, 4) = tbl.getElementsByTagName("td")(12).innerText
    Else
        Cells(2, 2) = False
    End If
    IE.Quit
    Set IE = Nothing
 End Sub