问题
Let me preface my post by noting that I am quite new to leveraging this side of VBA.
I am interested in requesting a token from a web service which requires I make an HTTP "POST" request using an authorization code I have personally. I am needing to include this code, among other parameters in my request, but am struggling to do so successfully. Any detail I find online formats their request in Java as follows (all IDs are faked):
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
Producing a request like this has been a real struggle personally. Below are the relevant components of my code:
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
end sub
Any ideas as to why these parameters are causing this request to fail? Any insight is greatly appreciated!
回答1:
Request's body might need to be of the structure:
Dim Payload as string
Payload = "grant_type=" & "authorization_code" & _
"&code=" & "BLAHBLAHBLAH" & _
"&client_id=" & "OFMICEANDMEN" & _
"&client_secret=" & "MELOVEYOULONGTIME" & _
"&redirect_uri=" & "YOUMAYHAVETOUSELOOPBACKADDRESSIFYOUHAVENOREDIRECTURL"
Each of the garbage parameter values that I've put above (that you'll be replacing with your own) need to be URL encoded before you send the request, so that they aren't changed/corrupted in transit. Some values might also need to be base64 encoded BEFORE you URL encode them. To know which ones the server expects to be base64 encoded, consult the API documentation (it definitely seems like the 'code' value is first base64 encoded, then URL encoded).
URL encoding can be done in newer Excel versions via: Application.Encode(StringToURLEncode), which will return a URL-safe string.
Base64 encoding can be done by creating a function. Search this site for base64 encode vba, there are many ready-to-use examples.
Depending on the server you're POSTing to, you might need to set a header like:
Dim WebClient as WinHttp.WinHttpRequest
Set Webclient = new winhttp.winhttprequest
With webclient
.open "POST", " YOURURL.COM", False
.setrequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send Payload
.waitforresponse
Debug.print .responsetext
End with
回答2:
I don't know what API you are referring to, whereas there is a new API in which the oldest 'guide' is dated 'Mar' presumably 2019.
https://developer.tdameritrade.com/apis
https://developer.tdameritrade.com/guides
Wherein there is NO reference to the "&client_secret=" being needed !. In the 'latest' API, you request the 'code' as follows directly into your browser. It is good got a very few minutes.
https://auth.tdameritrade.com/oauth?
client_id=XXXX@AMER.OAUTHAP&response_type=code&redirect_uri=https://192.168.0.100
The response appears in the browser's entry, not in the body, You have to decode the response to use the 'code'. The RefreshToken (90 days valid) & AccessToken (30 minutes valid) are used as the are returned in the ResponseText
To get the 90 day RefreshToken and the first AccessToken This is VBA which calls Javascript.
Private Sub Get_RefreshToken() 'Good for 90 days, then needs a new 'code', see above, also get the first AccessToken which are good for 30 minutes Dim code As String 'dcoded, not URL coded 'WAITS for the RESPONSE, NO callback Dim shtSheetToWork As Worksheet Set shtSheetToWork = ActiveWorkbook.Sheets("AUTH") '<<== may NEED change With shtSheetToWork authorizationcode = .Range(3, "C") // dump into Excel and decode by rows 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' ")
Stop Case 401 MsgBox (" Invalid credentials ") Stop Case 403 MsgBox (" caller doesn't have access to the account ") Stop Case 405 MsgBox (" Response without Allow Header") Stop Case 500 MsgBox (" unexpected server error ") Stop Case 503 MsgBox ("temporary problem responding, RETRYING !! ") ' WAIT A MINUTE AND RETRY
End Select
Set xmlhttp = Nothing
Set JsonObj = Nothing
End With
End Sub
Private Sub AccessToken() 'WAITS for the RESPONSE, NO callback Dim code As String 'dcoded, not URL coded Dim shtSheetToWork As Worksheet Set shtSheetToWork = ActiveWorkbook.Sheets("AUTH") '<<== may NEED change With 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' ")
Stop Case 401 MsgBox (" Invalid credentials ") Stop Case 403 MsgBox (" caller doesn't have access to the account ") Stop Case 405 MsgBox (" Response without Allow Header") Stop Case 500 MsgBox (" unexpected server error ") Stop Case 503 MsgBox ("temporary problem responding, RETRYING !! ") ' WAIT A MINUTE AND RETRY
End Select
Next i
Set xmlhttp = Nothing
End With End Sub
来源：https://stackoverflow.com/questions/48027143/adding-parameters-to-vba-http-post-request