让我在帖子前言，指出我很难利用VBA的这一面。
我有兴趣从Web服务请求令牌，这需要我使用我亲自授权的代码发出HTTP“POST”请求。我需要在我的请求中包含此代码以及其他参数，但我很难成功地这样做。我在网上找到的任何细节都用Java格式化他们的请求如下（所有ID都伪造）：
POST /services/oauth2/token HTTP/1.1
Host: "YourURL.com"
grant_type=authorization_code&code=aPrxsmIEeqM9PiQroGEWx1UiMQd95_5JUZ
VEhsOFhS8EVvbfYBBJli2W5fn3zbo.8hojaNW_1g%3D%3D&client_id=3MVG9lKcPoNI
NVBIPJjdw1J9LLM82HnFVVX19KY1uA5mu0QqEWhqKpoW3svG3XHrXDiCQjK1mdgAvhCs
cA9GE&client_secret=1955279925675241571&
redirect_uri=https%3A%2F%2Fwww.mysite.com%2Fcode_callback.jsp
制作这样的请求一直是个人的真正斗争。以下是我的代码的相关组件：
Dim request As WinHttp.WinHttpRequest
Dim
client_id,
redirect_uri,
grant_type,
client_secret,
authcode,
result,
token_url,
As String
Sub testmod（）
Set request = New WinHttp.WinHttpRequest
client_id = "MyClientID"
client_secret = "MyClientSecret"
grant_type = "authorization_code"
redirect_uri = "MyRedirectURI"
authcode = "MyAuthorizationCode"
token_url = "MyTokenURL" <--- No specified query string appended
With request
.Open method:="POST", Url:=token_url
''''Including POST Params with Send method''''
.Send ("{""code"":" & authcode &
",""grant_type"":authorization_code,""client_id"":" & client_id &
",""client_secret"":" & client_secret & ",""redirect_uri"":" &
redirect_uri & "}")
''''This returns error code 400 denoting a bad request''''
Debug.Print .StatusText
end with
结束子
关于为什么这些参数导致此请求失败的任何想法？非常感谢任何见解！
答案 0 :(得分：0)
请求的正文可能需要具有以下结构：
<?php
if (array_key_exists('delete_file', $_POST)) {
$filename = $_POST['delete_file'];
if (file_exists($filename)) {
unlink($filename);
echo 'File '.$filename.' has been deleted';
} else {
echo 'Could not delete '.$filename.', file does not exist';
}
}
?>
我发送上面的每个垃圾参数值（您将自己替换）都需要在发送请求之前进行URL编码，以便它们在传输过程中不会被更改/损坏。在对URL进行URL编码之前，某些值可能还需要进行base64编码。要知道服务器期望哪些是base64编码的，请参考API文档（看起来'代码'值首先是base64编码，然后是URL编码）。
URL编码可以在较新的Excel版本中通过以下方式完成：Application.Encode（StringToURLEncode），它将返回一个URL安全字符串。
Base64编码可以通过创建函数来完成。在这个站点搜索base64 encode vba，有很多现成的例子。
根据您要发布到的服务器，您可能需要设置标题，如：
Dim Payload as string
Payload = "grant_type=" & "authorization_code" & _
"&code=" & "BLAHBLAHBLAH" & _
"&client_id=" & "OFMICEANDMEN" & _
"&client_secret=" & "MELOVEYOULONGTIME" & _
"&redirect_uri=" & "YOUMAYHAVETOUSELOOPBACKADDRESSIFYOUHAVENOREDIRECTURL"
答案 1 :(得分：0)
我不知道您指的是什么API，但是有一个新的API，其中最古老的“指南”的日期可能是“ Mar”，大概是2019年。
https://developer.tdameritrade.com/apis
https://developer.tdameritrade.com/guides
其中没有引用“＆client_secret =“。 在“最新” API中，您可以直接向浏览器请求以下“代码”。几分钟就好了。
https://auth.tdameritrade.com/oauth?
client_id=XXXX@AMER.OAUTHAP&response_type=code&redirect_uri = https://192.168.0.100
响应将显示在浏览器的条目中，而不是在正文中。您必须对响应进行解码才能使用“代码”。 RefreshToken（有效期为90天）和AccessToken（有效期为30分钟）用作ResponseText中返回的
获取90天的RefreshToken和第一个AccessToken 这是调用Javascript的VBA。
Private Sub Get_RefreshToken（）'有效期为90天，然后需要一个新的'代码'，请参见上文，并获得第一个有效时间为30分钟的AccessToken 暗码为字符串编码，而不是URL编码，等待响应，无回调 昏暗的shtSheetToWork作为工作表 设置shtSheetToWork = ActiveWorkbook.Sheets（“ AUTH”）'<< ==可能需要更改 使用shtSheetToWork authorizationcode = .Range（3，“ C”）//转储到Excel中并按行JSON'split'解码
Dim xmlhttp As Object
Dim scriptControl As Object
Dim Response, JsonObj As Object
Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
Set scriptControl = CreateObject("MSScriptControl.ScriptControl")
scriptControl.Language = "JScript"
authUrl = "https://api.tdameritrade.com/v1/oauth2/token"
xmlhttp.Open "Post", authUrl, False
xmlhttp.Send "{grant_type: authorization_code, authorizationcode: ,access_type: offline, client_id: .UserId, redirect_uri: .URLredirect}"
Response = scriptControl.Eval(xmlhttp.responseText)
.Range(4, "C") = Response.refresh_token 'RefreshToken
xmlhttp.setRequestHeader "Authorization", Response.refresh_token
xmlhttp.Send
MsgBox (xmlhttp.responseText)
Select Case xmlhttp.Status
Case 200
Dim i As Integer
Dim strKey As String
Dim strVal As Variant
Dim JsonData As Variant
JsonObj = JsonDate.Parse(xmlhttp.responseText)
Cells(colstr, toprow - 1) = JsonObj
i = 1
Do While Trim(Cells(i, 1)) <> ""
Name = Split(Cells(i, 1).Text, ":")
If Name = "RefreshToken" Then .RefreshToken = Name: .nextRefreshToken = DateAdd("d", 90, Now)
If Name = "AccessToken" Then .AccessToken = Name: .nextAccessToken = DateAdd("m", 30, Now)
Case 400
MsgBox (" validation problem suthorization 'CODE' ")
停止 案例401 MsgBox（“无效凭据”） 停止 案例403 MsgBox（“呼叫者无权访问该帐户”） 停止 案例405 MsgBox（“没有允许标题的响应”） 停止 案例500 MsgBox（“服务器意外错误”） 停止 案例503 MsgBox（“临时问题正在响应，正在重试！”） '等待一分钟并重试
End Select
Set xmlhttp = Nothing
Set JsonObj = Nothing
End With
结束子
Private Sub AccessToken（）'等待响应，没有回调 暗码为String编码，而非URL编码 昏暗的shtSheetToWork作为工作表 设置shtSheetToWork = ActiveWorkbook.Sheets（“ AUTH”）'<< ==可能需要更改 使用shtSheetToWork
Dim xmlhttp As Object
Dim scriptControl As Object
Dim Response, JsonObj As Object
Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
Set scriptControl = CreateObject("MSScriptControl.ScriptControl")
scriptControl.Language = "JScript"
authUrl = "https://api.tdameritrade.com/v1/oauth2/token"
xmlhttp.Open "Post", authUrl, False
xmlhttp.Send "{grant_type: refresh_token, authorizationcode: .RefreshToken, access_type: , client_id: .MYUserId, redirect_uri: }"
Response = scriptControl.Eval(xmlhttp.responseText)
.AccessToken = Response.refresh_token
xmlhttp.setRequestHeader "Authorization", RefreshToken
xmlhttp.Send
'MsgBox (xmlhttp.responseText)
Select Case xmlhttp.Status
Case 200
Dim i As Integer
Private strKey As String
Private strVal As Variant
Private Data As Variant
JsonObj = Json.Parse(xmlhttp.responseText)
Cells(colstr, toprow - 1) = JsonObj
NextText = Cells(colstr, toprow - 1)
JsonObj = Nothing
i = 1
Do While Trim(Cells(i, 1)) <> ""
Name = Split(Cells(i, 1).Text, ":")
If Name = "RefreshToken" Then .RefreshToken = Name: .nextRefreshToken = DateAdd("d", 90, Now)
If Name = "AccessToken" Then .AccessToken = Name: .nextAccessToken = DateAdd("m", 30, Now)
Case 400
MsgBox (" validation problem suthorization 'CODE' ")
停止 案例401 MsgBox（“无效凭据”） 停止 案例403 MsgBox（“呼叫者无权访问该帐户”） 停止 案例405 MsgBox（“没有允许标题的响应”） 停止 案例500 MsgBox（“服务器意外错误”） 停止 案例503 MsgBox（“临时问题正在响应，正在重试！”） '等待一分钟并重试
End Select
Next i
Set xmlhttp = Nothing
结尾为 结束