Excel VBA实现新Access Token获取：转换PowerShell curl命令遇错误

我在PowerShell中运行以下命令可成功获取有效的新refresh token和bearer token：

curl.exe -X POST https://app.inventorum.com/api/auth/token/ -u '$CLIENTID:$CLIENTSECRET' -d 'grant_type=refresh_token&refresh_token=$REFRESHTOKEN'

尝试用Excel VBA实现相同功能时，编写了如下代码：

Private Function getAccessToken() As String
Dim httpRequest As New WinHttpRequest
Dim apiUrl As String

apiUrl = "https://app.inventorum.com/api/auth/token/"

httpRequest.Open "POST", apiUrl
httpRequest.SetCredentials clientId, clientSecret, 0
httpRequest.send "grant_type=refresh_token&refresh_token=" & refreshToken

Debug.Print httpRequest.responseText
End Function

但返回响应为：

{"error": "unsupported_grant_type"}

问题原因与解决方法 #

报错的核心原因有两个：

1. 缺少Content-Type请求头：PowerShell的curl会自动为-d参数设置Content-Type: application/x-www-form-urlencoded，而VBA的WinHttpRequest默认不会添加该头，导致API无法识别请求体格式，进而判定grant_type无效。
2. Basic认证方式不匹配：虽然SetCredentials本质是HTTP Basic认证，但部分API要求显式将CLIENTID:CLIENTSECRET做Base64编码后放入Authorization头，而非依赖SetCredentials的隐式处理。

修正后的完整VBA代码 #

Private Function getAccessToken() As String
    Dim httpRequest As New WinHttpRequest
    Dim apiUrl As String
    Dim authHeader As String
    Dim postData As String
    
    apiUrl = "https://app.inventorum.com/api/auth/token/"
    ' 构造Basic认证头：将ClientID与ClientSecret拼接后做Base64编码
    authHeader = "Basic " & EncodeBase64(clientId & ":" & clientSecret)
    postData = "grant_type=refresh_token&refresh_token=" & refreshToken
    
    With httpRequest
        .Open "POST", apiUrl, False
        ' 必须设置表单编码类型的Content-Type头
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        ' 显式设置Authorization认证头
        .SetRequestHeader "Authorization", authHeader
        ' 发送请求体
        .send postData
        ' 输出完整响应到调试窗口
        Debug.Print .responseText
        ' 解析并返回access_token（可根据需求调整）
        getAccessToken = ParseJsonField(.responseText, "access_token")
    End With
End Function

' 辅助函数：字符串转Base64编码
Private Function EncodeBase64(inputStr As String) As String
    Dim byteArr() As Byte
    byteArr = StrConv(inputStr, vbFromUnicode)
    EncodeBase64 = EncodeBytesToBase64(byteArr)
End Function

Private Function EncodeBytesToBase64(inputBytes() As Byte) As String
    Dim xmlDoc As Object, b64Node As Object
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    Set b64Node = xmlDoc.createElement("base64")
    b64Node.DataType = "bin.base64"
    b64Node.nodeTypedValue = inputBytes
    EncodeBytesToBase64 = b64Node.Text
    Set b64Node = Nothing
    Set xmlDoc = Nothing
End Function

' 辅助函数：简单解析JSON字段（无第三方库时使用）
Private Function ParseJsonField(jsonStr As String, fieldName As String) As String
    Dim startIdx As Long, endIdx As Long
    startIdx = InStr(jsonStr, """" & fieldName & """") + Len(fieldName) + 3
    endIdx = InStr(startIdx, jsonStr, """")
    If startIdx > 0 And endIdx > startIdx Then
        ParseJsonField = Mid(jsonStr, startIdx, endIdx - startIdx)
    End If
End Function

关键修正点说明 #

• 新增Content-Type请求头，明确告知API请求体采用表单编码格式，与PowerShell请求保持一致。
• 手动构造Basic认证头，确保认证信息的编码和传递方式符合API要求。
• 补充Base64编码和简单JSON解析的辅助函数，完善token获取的完整流程。

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