MS Access VBA的MSXML2.ServerXMLHTTP请求出现401未授权错误

你的VBA代码出现401未授权错误，核心问题是请求内容格式与声明的Content-Type不匹配，同时参数传递逻辑存在错误，具体如下：

1. Content-Type与请求体格式冲突 #

你设置了Content-Type: application/json，但发送的请求体是用&拼接的纯文本格式（仅传递参数值，丢失参数名），服务器无法正确解析请求参数，导致鉴权失败。而POSTMAN中你应该是选择了form-data或x-www-form-urlencoded格式，因此能成功获取令牌。

2. 参数传递逻辑错误 #

当前用Join(params.Items, "&")拼接参数，只会得到client_credentials&true这种无参数名的字符串，完全不符合接口要求的参数格式，服务器无法识别grant_type等关键参数。

修复后的完整代码 #

Public Function getTokentemp() As String
    Dim url As String
    Dim Auth As String
    Dim headers As Object
    Dim params As Object
    Dim tokenRequest As Object
    Dim postData As String
    Dim key As Variant

    clientId = "CLIENTID GOES HERE"
    clientSecret = "SECRET INFO HERE"
    url = "https://URLHERE.com/oauth/token"
    Auth = clientId & ":" & clientSecret
    ' 编码为Base64格式
    Auth = EncodeBase64(Auth)
    
    ' 构建请求头
    Set headers = CreateObject("Scripting.Dictionary")
    headers("Authorization") = "Basic " & Auth
    ' 修改为表单格式的Content-Type，匹配POSTMAN的请求设置
    headers("Content-Type") = "application/x-www-form-urlencoded"
    
    ' 构建请求参数
    Set params = CreateObject("Scripting.Dictionary")
    params("grant_type") = "client_credentials"
    params("x-sap-sac-custom-auth") = "true"
    
    ' 正确拼接键值对格式的表单参数
    postData = ""
    For Each key In params.Keys
        If postData <> "" Then postData = postData & "&"
        ' 简单转义特殊字符，避免参数解析错误
        postData = postData & key & "=" & Replace(params(key), "&", "%26")
    Next key
    
    ' 发送HTTP请求
    Set tokenRequest = CreateObject("MSXML2.ServerXMLHTTP")
    With tokenRequest
        .Open "POST", url, False
        ' 设置请求头
        For Each key In headers
            .setRequestHeader key, headers(key)
        Next key
        ' 发送正确格式的请求体
        .send postData
        
        ' 处理响应
        If .Status = 200 Then
            getTokentemp = .responseText
            MsgBox getTokentemp
        Else
            MsgBox "Error: " & .Status & " - " & .StatusText
        End If
    End With
    
    ' 清理对象
    Set tokenRequest = Nothing
    Set headers = Nothing
    Set params = Nothing
End Function

Function EncodeBase64(ByVal str As String) As String
    Dim arrData() As Byte
    Dim objXML As Object

    arrData = StrConv(str, vbFromUnicode)
    Set objXML = CreateObject("MSXML2.DOMDocument")
    With objXML.CreateElement("b64")
        .DataType = "bin.base64"
        .NodeTypedValue = arrData
        EncodeBase64 = .text
    End With
    Set objXML = Nothing
End Function

额外验证点 #

• 确认x-sap-sac-custom-auth的位置：如果POSTMAN中该参数是放在请求头而非表单里，需要将其从params字典移到headers字典中。
• 对比Base64编码结果：将VBA生成的Authorization头值与POSTMAN中的值对比，确保编码完全一致，避免编码逻辑错误导致鉴权失败。

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