更新税费链接后，增值税号检查不起作用

以下内容似乎对我有用，但是您可能需要更改"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

注意事项：

• 我从GitHub上现有的PHP实现之一中获取了SOAP信封（此后我关闭了该特定的浏览器选项卡，否则将在我的答案中包含该链接）。
• 我没有将服务器的响应解析为XML文档，而是将其解析为字符串（不好，但是返回的资源很小）。
• 代码假定一切都会成功。如果请求超时或返回错误消息，则代码可能会引发错误（如果它不知道如何处理）
• 从EC自身网站上可用的技术资源/文档（例如WSDL和FAQ）中，似乎没有中央数据库（您的请求发送到他们的服务器，然后他们的服务器从相关国家/成员国的数据库中请求信息） 。
• 常规的配额/使用规定（管理任何服务/ API的使用）已经到位。如果他们在短时间内收到来自给定IP的太多请求，或者收到太多产生无效欧盟增值税号的请求，则他们可能会怀疑滥用其服务并将您的IP列入黑名单。

这是我的开始：

这是我在代码后得到的：