VIES VAT校验VBA代码修复请求：URL变更后代码失效

核心问题 #

你把SOAP服务接口的URL换成了VIES的前端网页地址，这是代码失效的主要原因——前端网页不接收SOAP格式的请求，必须使用官方提供的SOAP接口地址。

需要修正的内容 #

• 恢复正确的SOAP接口URL：
  把sURL的值改回HTTPS版本的SOAP接口（仅需将原HTTP协议改为HTTPS，路径保持不变）：

  sURL = "https://ec.europa.eu/taxation_customs/vies/services/checkVatService"
  

• 完善请求头设置：
  原代码的Content-Type缺少字符集声明，容易导致XML解析失败，修正为：

  .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
  

• 优化错误处理：
  移除全局的On Error Resume Next，在关键步骤添加错误判断，避免因接口返回异常导致代码崩溃。比如在解析XML前检查请求状态和节点是否存在。

修正后的完整代码 #

Sub VATCHECK()
    Dim sURL As String
    Dim sEnv As String
    Dim xmlhttp As New MSXML2.xmlhttp
    Dim xmlDoc As New MSXML2.DOMDocument
    Dim sCountryCode As String
    Dim sVATNo As String
    Dim i As Long
    
    Range("D2", Range("D2").End(xlDown)).Clear
    If Cells(Rows.Count, 1).End(xlUp).Row < 2 Then Exit Sub

    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        ' 使用正确的SOAP接口URL
        sURL = "https://ec.europa.eu/taxation_customs/vies/services/checkVatService"
        sCountryCode = Range("B" & i).Value
        sVATNo = Range("C" & i).Value
    
        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>" & sCountryCode & "</urn:countryCode>"
        sEnv = sEnv & "<urn:vatNumber>" & sVATNo & "</urn:vatNumber>"
        sEnv = sEnv & "</urn:checkVat>"
        sEnv = sEnv & "</soapenv:Body>"
        sEnv = sEnv & "</soapenv:Envelope>"

        With xmlhttp
            .Open "POST", sURL, False
            ' 完善Content-Type头
            .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
            .send sEnv
            
            ' 检查请求状态
            If .Status <> 200 Then
                Range("D" & i).Value = "请求失败（状态码：" & .Status & "）"
                GoTo NextRow
            End If
        
            Set xmlDoc = New MSXML2.DOMDocument
            xmlDoc.LoadXML .responseText
            
            ' 检查valid节点是否存在
            If xmlDoc.getElementsByTagName("valid").Length = 0 Then
                Range("D" & i).Value = "接口返回异常"
                GoTo NextRow
            End If
            
            If Range("A" & i).Value = 0 Then
                Range("D" & i).Value = ""
            Else
                If LCase(xmlDoc.getElementsByTagName("valid").Item(0).Text) = "true" Then
                    Range("D" & i).Value = "Valid VAT number"
                Else
                    Range("D" & i).Value = "Invalid VAT number"
                End If
            End If
        End With
NextRow:
    Next i
  
End Sub

内容的提问来源于stack exchange，提问作者Krzysztof