如何在Excel VBA中实现OAuth2授权码模式获取令牌并调用API？

一、客户端凭证模式（对应你已实现的Python代码转换） #

获取访问令牌 #

Function GetOAuthToken_ClientCredentials() As String
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    Dim tokenUrl As String
    Dim clientId As String
    Dim clientSecret As String
    Dim postData As String
    
    ' 替换为你的实际参数
    tokenUrl = "https://your-auth-server/token"
    clientId = "your-client-id"
    clientSecret = "your-client-secret"
    
    ' 构造x-www-form-urlencoded格式的请求体
    postData = "grant_type=client_credentials" & _
               "&client_id=" & URLEncode(clientId) & _
               "&client_secret=" & URLEncode(clientSecret)
    
    With http
        .Open "POST", tokenUrl, False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .Send postData
        
        If .Status = 200 Then
            ' 简单解析JSON返回的access_token，复杂场景建议用JSON解析库
            Dim responseText As String
            responseText = .responseText
            GetOAuthToken_ClientCredentials = Split(Split(responseText, """access_token"":""")(1), """")(0)
        Else
            MsgBox "获取令牌失败：" & .Status & " " & .statusText
            GetOAuthToken_ClientCredentials = ""
        End If
    End With
    
    Set http = Nothing
End Function

' URL编码辅助函数
Function URLEncode(ByVal str As String) As String
    Dim bytes() As Byte
    bytes = StrConv(str, vbUnicode)
    Dim i As Integer
    Dim charCode As Integer
    Dim result As String
    For i = 0 To UBound(bytes) Step 2
        charCode = bytes(i)
        Select Case charCode
            Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95, 126
                result = result & Chr(charCode)
            Case Else
                result = result & "%" & Hex(charCode)
        End Select
    Next i
    URLEncode = result
End Function

调用受保护的API #

Sub CallProtectedAPI()
    Dim token As String
    token = GetOAuthToken_ClientCredentials()
    If token = "" Then Exit Sub
    
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    Dim apiUrl As String
    apiUrl = "https://your-api-server/protected-endpoint"
    
    With http
        .Open "GET", apiUrl, False
        ' 在请求头中携带Bearer令牌
        .SetRequestHeader "Authorization", "Bearer " & token
        .Send
        
        If .Status = 200 Then
            MsgBox "API响应：" & .responseText
        Else
            MsgBox "API调用失败：" & .Status & " " & .statusText
        End If
    End With
    
    Set http = Nothing
End Sub

二、授权码模式（你偏好的类型） #

授权码模式需要两步：引导用户授权获取授权码，再用授权码换取令牌。

第一步：打开授权页面获取授权码 #

Sub OpenAuthPage()
    Dim authUrl As String
    Dim clientId As String
    Dim redirectUri As String
    Dim scope As String
    
    clientId = "your-client-id"
    redirectUri = "https://your-redirect-uri" ' 需与认证服务器配置一致
    scope = "your-api-scope"
    
    authUrl = "https://your-auth-server/authorize?" & _
              "response_type=code" & _
              "&client_id=" & URLEncode(clientId) & _
              "&redirect_uri=" & URLEncode(redirectUri) & _
              "&scope=" & URLEncode(scope)
    
    ' 打开浏览器让用户完成授权，授权后从重定向URL中提取code参数
    Shell "explorer.exe " & authUrl, vbNormalFocus
End Sub

第二步：用授权码换取令牌并调用API #

Function GetOAuthToken_AuthorizationCode(authCode As String) As String
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    Dim tokenUrl As String
    Dim clientId As String
    Dim clientSecret As String
    Dim redirectUri As String
    Dim postData As String
    
    tokenUrl = "https://your-auth-server/token"
    clientId = "your-client-id"
    clientSecret = "your-client-secret"
    redirectUri = "https://your-redirect-uri"
    
    postData = "grant_type=authorization_code" & _
               "&code=" & URLEncode(authCode) & _
               "&client_id=" & URLEncode(clientId) & _
               "&client_secret=" & URLEncode(clientSecret) & _
               "&redirect_uri=" & URLEncode(redirectUri)
    
    With http
        .Open "POST", tokenUrl, False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .Send postData
        
        If .Status = 200 Then
            GetOAuthToken_AuthorizationCode = Split(Split(.responseText, """access_token"":""")(1), """")(0)
        Else
            MsgBox "换取令牌失败：" & .Status & " " & .statusText
            GetOAuthToken_AuthorizationCode = ""
        End If
    End With
    
    Set http = Nothing
End Function

' 调用示例：先运行OpenAuthPage获取授权码，再输入到这里
Sub CallAPIWithAuthCode()
    Dim authCode As String
    authCode = InputBox("请输入授权码：")
    If authCode = "" Then Exit Sub
    
    Dim token As String
    token = GetOAuthToken_AuthorizationCode(authCode)
    If token = "" Then Exit Sub
    
    ' 调用API逻辑与客户端凭证模式一致
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    Dim apiUrl As String
    apiUrl = "https://your-api-server/protected-endpoint"
    
    With http
        .Open "GET", apiUrl, False
        .SetRequestHeader "Authorization", "Bearer " & token
        .Send
        
        If .Status = 200 Then
            MsgBox "API响应：" & .responseText
        Else
            MsgBox "API调用失败：" & .Status & " " & .statusText
        End If
    End With
    
    Set http = Nothing
End Sub

关键注意事项 #

• 所有your-xxx占位符需替换为实际的认证服务器地址、客户端ID、密钥、重定向URI等参数
• 简单字符串解析令牌仅适用于基础场景，若返回的JSON结构复杂，建议引入VBA-JSON等解析库处理
• 授权码模式中，重定向URI必须和认证服务器上配置的完全一致
• 生产环境请勿硬编码客户端密钥，建议通过注册表、加密文件等安全方式存储

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