Connect excel data to SOAP UI

rexone Here is some sample code (To try you need to enter a valid EU VAT number instead of the current placeholder text)). You'll have to change the envelope, the urls and the headings according to the documentation of the webservice you are trying to use.

Please note that this code requires setting a reference in VBA (Tools, References) to the library called "Microsoft XML, V5"

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 errorMsg 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 = "<?xml version=""1.0"" encoding=""utf-8""?>"
    sEnv = sEnv & "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"">"
    sEnv = sEnv & "    <soapenv:Body>"
    sEnv = sEnv & "        <urn:checkVat xmlns:urn=""urn:ec.europa.eu:taxud:vies:services:checkVat:types"">"
    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_", UCase("CountryCodeGoesHere"))
    sEnv = Replace(sEnv, "_VATNUMBER_", "VATNumerGoesHere")

    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 "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
        errorMsg = xmlDoc.getElementsByTagName("faultstring").Item(0).Text
        On Error GoTo 0
        If Len(errorMsg) > 0 Then
            MsgBox "Error: " & errorMsg
            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