VBA获取token方法

获取token方法

'获取access_token方法

Sub 获取access_token()
    Debug.Print GetAccessToken("APIKey ", "SecretKey ")
End Sub










Function GetAccessToken(APIKey As String, SecretKey As String) As String
    Dim request As Object
    Dim response As String
    Dim url As String
    Dim payload As String
    Dim headers As Object
    
    ' 设置请求URL
    url = "https://aip.baidubce.com/oauth/2.0/token?grant_type=client_credentials&client_id=" & APIKey & "&client_secret=" & SecretKey
    
    ' 创建HTTP请求对象
    Set request = CreateObject("MSXML2.XMLHTTP")
    
    ' 构建请求参数
    payload = "{}"
    
    ' 设置请求头
    Set headers = CreateObject("Scripting.Dictionary")
    headers.Add "Content-Type", "application/json"
    headers.Add "Accept", "application/json"
    
    ' 发送POST请求
    With request
        .Open "POST", url, False
        For Each Header In headers
            .setRequestHeader Header, headers(Header)
        Next Header
        .send payload
        response = .responseText
    End With
    
    ' 解析响应结果，获取access_token
    GetAccessToken = ParseAccessToken(response)
End Function

Function ParseAccessToken(response As String) As String
    Dim sc As Object
    Dim json As Object
    Dim jsonResponse As String
    
    ' 创建ScriptControl对象
    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"
    
    ' 解析JSON字符串
    sc.addcode "function getRs(){return json.access_token;}"
    sc.Eval "var json = " & response
    

    'MsgBox sc.Run("getRs")
    ' 获取access_token字段的值
    ParseAccessToken = sc.Run("getRs")
End Function