Мне кажется, что приведенное ниже работает, но вам может потребоваться изменить "Sheet1" на имя листа, на котором расположены ваши данные.
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
Некоторые замечания:
- Я взял конверт SOAP из одной из существующих реализаций PHP на GitHub (с тех пор я закрыл эту конкретную вкладку браузера, в противном случае в моем ответе была бы ссылка).
- Вместо анализа сервераответ в виде XML-документа, я просто анализирую его как строку (не очень хорошо, но возвращаемый ресурс довольно мал).
- Код предполагает, что все будет успешно.Если запрос истекает или возвращается сообщение об ошибке, код, скорее всего, выдаст ошибку (если он не знает, как ее обработать)
- Из технических ресурсов / документации, доступных на собственном веб-сайте ЕС (например, WSDL и FAQ ), кажется, что нет центральной базы данных (ваш запрос отправляется на их сервер, затем их сервер запрашивает информацию из базы данных соответствующей страны / страны-члена).
- Действуют обычные условия квоты / использования (регулирующие потребление любого сервиса / API).Если они получат слишком много запросов от данного IP в течение короткого промежутка времени или слишком много запросов, которые приведут к неправильным номерам НДС в ЕС, они могут заподозрить неправильное использование своих услуг и занести в черный список ваш IP.
Это то, с чего я начинаю:
Это то, что я получаю после кода:
