VBA check VAT with VIES and return company details

[motomarzel]

Hi to everybody.

I am trying to create Excel based Invoice and Packing list. And I want to be able to automaticaly check the VAT numbers of the customer with VIES, collect the company data from there and fill it in dedicated cells.

For example:

I am typing the VAT number of the customer in one cell (C3) and the country code in another (B3), we have our company (requester) VAT in F3 and G3. Then I press a call button (which is invisible when printing) that runs macro, which checks with VIES database and returns Company name in cell (C4) and Address in another (C5). If the VAT is not valid, then it returns "Not Valid VAT" in C4 (company name field).

That thread might be helpful:
VBA IE automation

Thanks for the help in advance!

 

[jkpieterse]

This code appears to work. Up to you to turn it into a function which accepts a country code and a VAT number and returns what you need:

Option Explicit

'Reference: Microsoft XML, V4.0

Sub DoIt()
    Dim sURL As String
    Dim sEnv As String
    Dim xmlhtp As New MSXML2.XMLHTTP
    Dim xmlDoc As New DOMDocument
    Dim result As String
    Dim companyName As String
    Dim companyAddress As String
    'The webservice
    sURL = "http://ec.europa.eu/taxation_customs/vies/services/checkVatService"
   
    'Build the soap envelope the webservice needs
   
    sEnv = "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:urn=""urn:ec.europa.eu:taxud:vies:services:checkVat:types"">"
    sEnv = sEnv & "<soapenv:Header/>"
    sEnv = sEnv & "<soapenv:Body>"
    sEnv = sEnv & "<urn:checkVat>"
    sEnv = sEnv & "<urn:countryCode>_COUNTRYCODE_</urn:countryCode>"
    sEnv = sEnv & "<urn:vatNumber>_VATNUMBER_</urn:vatNumber>"
    sEnv = sEnv & "</urn:checkVat>"
    sEnv = sEnv & "</soapenv:Body>"
    sEnv = sEnv & "</soapenv:Envelope>"
   
    sEnv = Replace(sEnv, "_COUNTRYCODE_", "countryCodeGoesHere")
    sEnv = Replace(sEnv, "_VATNUMBER_", "VATNumberGoesHere")
   
    With xmlhtp
        'Open webservice
        .Open "post", sURL, False
        .setRequestHeader "Host", "http://ec.europa.eu/taxation_customs/vies/services"
        .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
        .setRequestHeader "soapAction", "http://ec.europa.eu/taxation_customs/vies/services/checkVatService"
        .setRequestHeader "Accept-encoding", "zip"
        'Send it the envelope
        .send sEnv
        'Now retrieve the result from the webservice
        xmlDoc.loadXML .responseText
         'To save the result to a file:
         'xmlDoc.Save ThisWorkbook.Path & "\WebQueryResult.xml"
        On Error Resume Next
        result = xmlDoc.getElementsByTagName("valid").Item(0).Text
        On Error GoTo 0
        If Len(result) = 0 Then
            MsgBox "Invalid soap envelope, VAT and/or countrycode invalid."
            Exit Sub
        End If
        companyName = xmlDoc.getElementsByTagName("name").Item(0).Text
        companyAddress = xmlDoc.getElementsByTagName("address").Item(0).Text
       
        If LCase(result) = "true" Then
            MsgBox "Valid VAT number" & vbNewLine & companyName & vbNewLine & companyAddress
        Else
            MsgBox "Invalid VAT number"
        End If
    End With
End Sub

 

[Adel1889]

Hi, I tried the posted code, but it seems something isn't working anymore.
I also tried to fix the errors, using informations i found in Documentation and here, but I can't set all the correct informations.

Can someone please help me?
Thank you

A.

 

[jkpieterse]

You need to update all the strings after xmlDoc.getElementsByTagName("
by adding ns2: to them:

For example, these two lines:

        companyName = xmlDoc.getElementsByTagName("name").Item(0).Text
        companyAddress = xmlDoc.getElementsByTagName("address").Item(0).Text

must become:

        companyName = xmlDoc.getElementsByTagName("ns2:name").Item(0).Text
        companyAddress = xmlDoc.getElementsByTagName("ns2:address").Item(0).Text

Repeat this change for all of them in the code

 

[Adel1889]

You need to update all the strings after xmlDoc.getElementsByTagName("
by adding ns2: to them:

For example, these two lines:

        companyName = xmlDoc.getElementsByTagName("name").Item(0).Text
        companyAddress = xmlDoc.getElementsByTagName("address").Item(0).Text

must become:

        companyName = xmlDoc.getElementsByTagName("ns2:name").Item(0).Text
        companyAddress = xmlDoc.getElementsByTagName("ns2:address").Item(0).Text

Repeat this change for all of them in the code

Thank you very much, I try immediately