RTD函数是一种程序函数，用途从支持COM自动化的程序中返回实时数据(real-time data)。

语法：RTD(ProgID，server，topic1，[topic2]，...)

参数：ProgID已安装在本地计算机中，经过注册的COM自动化加载宏的ProgID名称，该名称用引号引起来。Server是运行加载宏的服务器的名称

      如果没有服务器，程序是在本地计算机上运行，那么该参数为空白

      topic1，topic2，...为1到28个参数，这些参数放在一起代表一个唯一的实时数据。

{

    "errNum":0,

    "errMsg":"success",

    "retData":

    {

        "stockinfo":[

            {

                "name":"科大讯飞",

                "code":"sz002230",

                "OpenningPrice":31.59,

                "closingPrice":31.4,

                "currentPrice":30.92,

                "hPrice":32.45,

                "lPrice":30.28,

            }]

    }

}

     '该次请求的股票代码

 Private Code As String

     '该次请求的股票名称

 Private Index As String

     '该次请求Excel分配的TopicID

 Public TopicID As Integer

     '该次请求的返回值

 Public Value As Variant

 Public Property Get StockCode() As Variant

     If Left(Code, ) =  Then

         StockCode = "sh" & Code

     Else

         StockCode = "sz" & Code

     End If

 End Property

 Public Property Let StockCode(ByVal Value As Variant)

       Code = Value

 End Property

 Public Property Get StockIndex() As String

      StockIndex = Index

 End Property

 Public Property Let StockIndex(ByVal Value As String)

     Select Case Value

         Case "股票名称": Index = "name"

         Case "股票代码": Index = "code"

         Case "开盘价": Index = "OpenningPrice"

         Case "收盘价": Index = "closingPrice"

         Case "最新价": Index = "currentPrice"

         Case "最高价": Index = "hPrice"

         Case "最低价": Index = "lPrice"

         Case Else: Index = "name"

     End Select

 End Property

 Private url As String

 Private list As String

 Private Sub Class_Initialize()

     url = "http://apis.baidu.com/apistore/stockservice/stock?stockid="

     list = "&list=2"

 End Sub

 Private Function JsonText(stock As StockData) As String

 Dim strurl As String

 Set winhttp = CreateObject("WinHttp.WinHttpRequest.5.1")

     strurl = url & stock.StockCode & list

     winhttp.Open "GET", strurl, False

     winhttp.setRequestHeader "apikey", "你的apikey"

     winhttp.send

 JsonText = winhttp.ResponseText

 End Function

 Function QueryInfo(stock As StockData)

 Set scobj = CreateObject("MSScriptControl.ScriptControl")

     scobj.Language = "JavaScript"

     scobj.AddCode ("var query = " & JsonText(stock))

     scobj.AddCode ("var info =query.retData.stockinfo[0]")

     scobj.Eval ("var value = info." & stock.StockIndex)

     stock.Value = scobj.Eval("value")

 '非开盘时间，使用随机数模拟价格变化

 '    If stock.StockIndex = "name" Then

 '        stock.Value = scobj.Eval("value")

 '    Else

 '        stock.Value = scobj.Eval("value") + Format(Rnd * 10, "0.00")

 '    End If

 End Function

 Function QueryInfos(stocks As Collection)

 Dim temp As StockData

     For Each s In stocks

        Set temp = s

            QueryInfo temp

     Next s

 End Function

1、服务启动时做一些初始化。该方法的返回值为1时，表示服务启动
   参数是IRTDUpdateEvent对象，该对象有一个UpdateNotify方法很重要。起到通知的作用，执行方法后，Excel会调用IRtdServer_RefreshData方法更新数据
   Private Function IRtdServer_ServerStart(ByVal CallbackObject As IRTDUpdateEvent) As Long


2、rtd函数首次向服务请求数据时执行的方法。每一个请求会被分配一个TopicID(主题)
   Stings()与rtd函数的参数topic1,[topic2]对应，每一个唯一的topic组合对应一个TopicID
   GetNewValues，当它值为1时表示，每次工作簿打开都重新请求数据
   该方法的返回值类型为Variant类型，就是主题首次请求得到的值（即rtd公式的结果）

Private Function IRtdServer_ConnectData(ByVal TopicID As Long, Strings() As Variant, GetNewValues As Boolean) As Variant


3、IRTDUpdateEvent对象调用本方法更新数据(更新主题的数据)，即更新rtd公式的结果
Private Function IRtdServer_RefreshData(TopicCount As Long) As Variant()

4、删除某个主题会执行的方法,参数是被删除的主题的TopicID
Private Sub IRtdServer_DisconnectData(ByVal TopicID As Long)

5、服务器关闭时执行的方法，主要用来释放资源
Private Sub IRtdServer_ServerTerminate()

 Dim rtdUpdate As IRTDUpdateEvent

 Dim stocks As Collection

 Dim helper As StockHelper

 Dim WithEvents Timer As clsTimer

 Private Function IRtdServer_ServerStart(ByVal CallbackObject As IRTDUpdateEvent) As Long

         Set rtdUpdate = CallbackObject

         Set stocks = New Collection

         Set helper = New StockHelper

         Set Timer = New clsTimer

         Timer.Interval =

         Timer.Enabled = True

         IRtdServer_ServerStart =

 End Function

 Private Sub Timer_Timer()

     helper.QueryInfos stocks

     rtdUpdate.UpdateNotify

 End Sub

 Private Function IRtdServer_ConnectData(ByVal TopicID As Long, Strings() As Variant, GetNewValues As Boolean) As Variant

       GetNewValues = True

       Dim temp As New StockData

       　　temp.StockCode = Strings()

       　　temp.StockIndex = Strings()

       　　temp.TopicID = TopicID

       helper.QueryInfo temp

       stocks.Add temp

       IRtdServer_ConnectData = temp.Value

 End Function

 Public Function IRtdServer_RefreshData(TopicCount As Long) As Variant()

      Dim objs() As Variant

      Dim i As Integer

      TopicCount = stocks.Count

      ReDim objs( To ,  To TopicCount - )

        For Each s In stocks

                 objs(, i) = s.TopicID

                 objs(, i) = s.Value

                 i = i +

        Next

      IRtdServer_RefreshData = objs

 End Function