EXCEL VBA调用聚宽分时数据接口

LeverHz

原帖连接：
https://www.joinquant.com/view/community/detail/6da3ec606f80aca0646a8476cadd199c


找了好久的分时数据接口，朋友推荐了聚宽，在win10，EXCEL 2019下测试有效，分享给大家。
大家再配合API接口文档，应该在1个小时内能调通。
注意帐号密码需要替代。Public Const JK_USER_NAME           As String = """XXX"""   '自带了前后"，方便拼接Public Const JK_PASSWORD            As String = """XXX"""Public g_JKToken As String      '存储聚宽的tokenPublic g_JKTokenUpdateDate As Date     '存储更新token的日期，每天需要更新一次' 1m, 5m, 15m, 30m, 60m, 120m, 1d, 1w, 1M。其中m表示分钟，d表示天，w表示周，M表示月Public Const JK_PERIOD_1MIN     As String = """1m"""Public Const JK_PERIOD_5MIN     As String = """5m"""Public Const JK_PERIOD_15MIN    As String = """15m"""Public Const JK_PERIOD_30MIN    As String = """30m"""Public Const JK_PERIOD_60MIN    As String = """60m"""Public Const JK_PERIOD_120MIN   As String = """120m"""Public Const JK_PERIOD_1DAY     As String = """1d"""Public Const JK_PERIOD_1WEEK    As String = """1w"""Public Const JK_PERIOD_1MONTH   As String = """1M"""
'**' 获取聚宽数据token'**Private Function DRV_JK_GetNewToken(vToken As String) As Long    Dim oXML As Variant, vBody As String, vMsgRx As String
Set oXML = CreateObject("Msxml2.XMLHTTP")
oXML.Open "POST", "https://dataapi.joinquant.com/apis", False
oXML.setRequestHeader "Content-Type", "application/json;charset=UTF-8"
vBody = "{""method"":""get_token"",""mob"":" & JK_USER_NAME & ",""pwd"":" & JK_PASSWORD & "}"
oXML.send (vBody)
vMsgRx = oXML.responsetext
'DRV_DebugLog LOG_LVL_DEBUG, vBuf
If InStr(vMsgRx, "error") Then
    DRV_DebugLog LOG_LVL_ERR, "Get JK token faild, " & vMsgRx
    DRV_JK_GetNewToken = EC_ERR
Else
    vToken = vMsgRx
    DRV_JK_GetNewToken = EC_OK
End If
End Function
'**' 获取聚宽数据token'**Private Function DRV_JK_GetToken() As String    Dim vToken As String
If ("" = g_JKToken) Or (g_JKTokenUpdateDate < > Date) Then
    If EC_OK = DRV_JK_GetNewToken(vToken) Then
        '非原子操作，在零点附近首次调用这个接口可能导致一直失败，关掉程序，重新调用一次即可
        g_JKToken = vToken
        g_JKTokenUpdateDate = Date
    End If
End If
DRV_JK_GetToken = g_JKToken
'DRV_DebugLog LOG_LVL_DEBUG, g_JKToken &amp; " " &amp; g_JKTokenUpdateDate
End Function
'**' 获取聚宽数据剩余可用次数'**Private Function DRV_JK_GetRestCnt(vToken As String, vCnt As Long) As Long    Dim oXML As Variant, vBody As String, vMsgRx As String
Set oXML = CreateObject("Msxml2.XMLHTTP")
oXML.Open "POST", "https://dataapi.joinquant.com/apis", False
oXML.setRequestHeader "Content-Type", "application/json;charset=UTF-8"
vBody = "{""method"" : ""get_query_count"", ""token"":""" &amp; vToken &amp; """}"
oXML.send (vBody)
vMsgRx = oXML.responsetext
'DRV_DebugLog LOG_LVL_DEBUG, vBuf
If InStr(vMsgRx, "error") Then
    DRV_DebugLog LOG_LVL_ERR, "Get JK rest cnt faild, " &amp; vMsgRx
    DRV_JK_GetRestCnt = EC_ERR
Else
    vCnt = vMsgRx
    DRV_JK_GetRestCnt = EC_OK
End If
End Function
'**' 预留50000次作为平时计算使用'**Private Function DRV_JK_StopQuery() As Boolean    Dim vToken As String, vCnt As Long, iRet As Long
DRV_JK_StopQuery = False
If EC_OK = DRV_JK_GetRestCnt(DRV_JK_GetToken(), vCnt) Then
    ' Debug.Print "Rest query cnt " &amp; vCnt
    If vCnt < = JK_RESERVED_QUERY_CNT Then
        DRV_JK_StopQuery = True
    End If
End If
End Function
'**' 获取聚宽数据指定时间段的数据' 开始结束日期格式 2019-10-11 09:29:00' 除权信息格式 2019-10-18'**Private Function DRVJK_GetData(vToken As String, vCode As String, vMode As String,     vStartTime As String, vEndTime As String, vFqDate As String, vBuf As Variant) As Long
Dim oXML As Variant, vBody As String, vMsgRx As String, vRowNum As Long, i As Long, vColNum As Long, j As Long
Dim vTmp As Variant, vTmpRow As Variant
Set oXML = CreateObject("Msxml2.XMLHTTP")
oXML.Open "POST", "https://dataapi.joinquant.com/apis", False
oXML.setRequestHeader "Content-Type", "application/json;charset=UTF-8"
vBody = "{""method"":""get_price_period"",""token"":""" &amp; vToken &amp; """,""code"":""" &amp; vCode &amp; ".XSHE""," &amp; _
    """unit"":" &amp; vMode &amp; ",""date"":""" &amp; vStartTime &amp; """,""end_date"":""" &amp; vEndTime &amp; _
    """,""fq_ref_date"":""" &amp; vFqDate &amp; """}"
oXML.send (vBody)
vMsgRx = oXML.responsetext
If InStr(vMsgRx, "error") Then
    DRV_DebugLog LOG_LVL_ERR, "Get JK data faild, " &amp; vMsgRx
    DRV_JK_GetData = EC_ERR
Else
    vTmp = vMsgRx
    vTmp = Split(vTmp, Chr(10))
    vRowNum = UBound(vTmp)
    vTmpRow = Split(vTmp(0), ",")
    vColNum = UBound(vTmpRow)
    ReDim vBuf(vRowNum, vColNum)
    For i = 0 To vRowNum Step 1
        For j = 0 To vColNum Step 1
            vTmpRow = Split(vTmp(i), ",")
            vBuf(i, j) = vTmpRow(j)
        Next j
    Next i
    DRV_JK_GetData = EC_OK
End If
End Function
示例代码片段：                vStartTime = vDate & " " & Format(TimeValue(vHTime) - TimeValue(JK_FS_15MIN), "HH:MM:SS")                vEndTime = vDate & " " & Format(TimeValue(vHTime), "HH:MM:SS")
            vRet = DRV_JK_GetData(vToken, vCode, JK_PERIOD_1MIN, vStartTime, vEndTime, vFqDate, vBuf1Min)
            If EC_OK < > vRet Then
                DRV_DebugLog LOG_LVL_ERR, "Get JK 1MIN data failed, " &amp; vRet &amp; ", " &amp; vCode &amp; ", " &amp; vStartTime
                DRV_GetOneDayHLSeq = EC_ERR
                GoTo ERR_HANDLE
            End If