VBA实现UPS API OAuth2.0令牌创建遇10400授权头错误

可能的问题点及解决方案 #

1. Base64编码函数存在缺陷 #

VBA没有内置Base64编码能力，自定义的EncodeBase64函数大概率是问题根源：

• 未按UTF-8编码字符串：UPS要求clientId:clientSecret以UTF-8编码后再做Base64转换，若函数用了ANSI编码，结果会完全不符合要求。
• 编码结果含多余换行：部分Base64实现会每76个字符自动添加换行，这会直接破坏Authorization头的格式。

替换为以下经过验证的UTF-8 Base64编码函数：

Function EncodeBase64(ByVal inputStr As String) As String
    Dim bytes() As Byte
    bytes = StrConv(inputStr, vbFromUnicode) '转换为UTF-8字节数组
    Dim objXML As Object, objNode As Object
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = bytes
    EncodeBase64 = Replace(objNode.Text, vbCrLf, "") '移除自动添加的换行
    Set objNode = Nothing
    Set objXML = Nothing
End Function

2. 字符串连接符使用不当 #

VBA中字符串连接优先用&而非+，+在部分场景下会触发类型转换错误，导致Authorization头拼接异常。修改代码为：

.setRequestHeader "Authorization", "Basic " & EncodeBase64(strHead)

3. 未指定TLS版本 #

UPS API要求使用TLS 1.2及以上版本，旧版MSXML2.ServerXMLHTTP默认可能未启用。添加以下代码强制启用TLS 1.2：

.Open "POST", "https://wwwcie.ups.com/security/v1/oauth/token"
.setOption 2, 13056 '启用TLS 1.2

4. x-merchant-id取值错误 #

示例中的"string"是占位符，必须替换为你实际的UPS商户ID，不能直接使用字面量字符串。

修改后的完整代码 #

Sub POST_Method_Example()
    Dim strHead As String, strClientId As String, strClientSecret As String
    strClientId = "你的ClientID"
    strClientSecret = "你的ClientSecret"
    strHead = strClientId & ":" & strClientSecret

    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "POST", "https://wwwcie.ups.com/security/v1/oauth/token"
        .setOption 2, 13056 '启用TLS 1.2
        .setRequestHeader "Authorization", "Basic " & EncodeBase64(strHead)
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "x-merchant-id", "你的实际商户ID"
        .send "grant_type=client_credentials"
        Debug.Print .responseText
    End With
End Sub

Function EncodeBase64(ByVal inputStr As String) As String
    Dim bytes() As Byte
    bytes = StrConv(inputStr, vbFromUnicode)
    Dim objXML As Object, objNode As Object
    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = bytes
    EncodeBase64 = Replace(objNode.Text, vbCrLf, "")
    Set objNode = Nothing
    Set objXML = Nothing
End Function

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