Vfrdtyky

So I found this vba code to check VAT number via Excel. But the link that they used in the code doesnt work anymore and need 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, but unfortunatly 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

Thanks alot

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:

This is what I get after the code:

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