VBA URL解析问题

时间:2018-08-23 19:38:30

标签: vba excel-vba url

下面是API文档中的内容

身份验证和令牌交换: 从登录流中获取到request_token后,应将其发布到/ session / token以完成令牌交换并检索access_token。

curl https://api.kite.trade/session/token \
-H "X-Kite-Version: 3" \
-d "api_key=xxx" \
-d "request_token=yyy" \
-d "checksum=zzz"

我尝试使用以下VBA代码,但出现“缺少或错误的请求参数或值”错误。我从API文档进行的URL转换有效吗?

Sub doLogin()
    Dim api As String, requestToken As String, checksum As String, fullData As String, URL As String, jsonData As String
    Dim JSON As Object

    api = ThisWorkbook.Sheets("Login").Range("B1").Value
    requestToken = ThisWorkbook.Sheets("Login").Range("B2").Value
    checksum = ThisWorkbook.Sheets("Login").Range("B4").Value
    URL = "https://api.kite.trade/session/token"
    fullData = "X-Kite-Version: 3" & "api_key=" & api & "request_token=" & 
    requestToken & "checksum=" & checksum
    jsonData = CallPostMethod(URL, fullData)

    MsgBox jsonData
    Set JSON = JsonConverter.ParseJson(jsonData)
End Sub

Function CallPostMethod(URL As String, fullData As String)

    Dim lngTimeout
    Dim strUserAgentString
    Dim intSslErrorIgnoreFlags
    Dim blnEnableRedirects
    Dim blnEnableHttpsToHttpRedirects
    Dim strHostOverride
    Dim strLogin
    Dim strPassword
    Dim strResponseText
    Dim objWinHttp

    lngTimeout = 59000
    strUserAgentString = "http_requester/0.1"
    intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err
    blnEnableRedirects = True
    blnEnableHttpsToHttpRedirects = True
    strHostOverride = ""
    strLogin = ""
    strPassword = ""

    Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
    objWinHttp.Open "POST", URL
    objWinHttp.setRequestHeader "Content-type", "application/JSON"

    If strHostOverride <> "" Then
        objWinHttp.setRequestHeader "Host", strHostOverride
    End If

    objWinHttp.Option(0) = strUserAgentString
    objWinHttp.Option(4) = intSslErrorIgnoreFlags
    objWinHttp.Option(6) = blnEnableRedirects
    objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
    'objWinHttp.SetCredentials "APIKEY", "PASSWORD", 0

    On Error Resume Next
    objWinHttp.send (fullData)
    MsgBox objWinHttp.responseText
    Debug.Print objWinHttp.responseText
    '
    'Call getFundInformation
    If err.Number = 0 Then
        If objWinHttp.Status = "200" Then
            CallPostMethod = objWinHttp.responseText
        Else
            CallPostMethod = "HTTP " & objWinHttp.Status & " " & _
            objWinHttp.StatusText
        End If
    Else
        CallPostMethod = "Error " & err.Number & " " & err.Source & " " & _
        err.Description
    End If
    On Error GoTo 0
    Set objWinHttp = Nothing
End Function

0 个答案:

没有答案