主题：将指定期货最新行情数据写入Excel的代码

Public MyXL
private StockCode(30),StockMarket(30)

Sub APPLICATION_VBAStart()
 Call Application.SetTimer(10, 500)
 GetExcelFile("D:\Stock.xls")
End Sub

Sub APPLICATION_Timer(ID)
 GetStockCode
 GetNewPrice
end sub

Sub GetNewPrice()
  dim i
 dim j
 on error resume next
 i=CDbl(Document.GetPrivateProfileString("Stock","StockCount",1,"D:\StockCode.INI"))
 For j=1 to i
  application.MsgOut "正在导出:" & StockCode(j) & "行情..."
   Set Report1 = marketdata.GetReportData(StockCode(j),StockMarket(j))
   MyXL.Application.activesheet.Range("C" & Cstr(j+3)) =  StockCode(j)
  MyXL.Application.activesheet.Range("D" & Cstr(j+3)) =  report1.BuyPrice1
  MyXL.Application.activesheet.Range("E" & Cstr(j+3)) =  report1.SellPrice1
 Next  
End Sub

'取得要监控的品种代码
Sub GetStockCode()
 dim i
 dim j
 i=CDbl(Document.GetPrivateProfileString("Stock","StockCount",1,"D:\StockCode.INI"))
 For j=1 to i
  StockCode(j)=Document.GetPrivateProfileString("Stock","Code" & Cstr(j),"","D:\StockCode.INI")  '品种号码
  StockMarket(j)=Document.GetPrivateProfileString("Stock","Market" & Cstr(j),"","D:\StockCode.INI") '交易所代码
  'application.MsgOut "i:" & i & "," & stockcode(j) & "," & StockMarket(j)
 Next
End Sub
'打开Excel
Sub GetExcel()
    Const ERR_APP_NOTRUNNING = 429
 
    On Error Resume Next
    Set MyXL = GetObject(, "Excel.Application")
    If Err = ERR_APP_NOTRUNNING Then
        Set MyXL = CreateObject("Excel.Application")
    End If
   
    MyXL.Application.Visible = True
End Sub
'打开某个excel文件
Sub GetExcelFile(sFileName)
    '此过程暂停使用,替代过程为:GetExcel

    Dim sWinName                '窗口名
    Dim iPos
   
    '测试 Microsoft Excel 的副本是否在运行。
    On Error Resume Next    '延迟错误捕获。
    '不带第一个参数调用 Getobject 函数将
    '返回对该应用程序的实例的引用。
    '如果该应用程序不在运行，则会产生错误。
    Set MyXL = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
  Set MyXL = CreateObject("Excel.Application")
 End if

    '将对象变量设为对要看的文件的引用。
    Set MyXL = GetObject(sFileName)
   
    iPos = InStrRev(sFileName, "\", -1, vbTextCompare)
    sWinName = Mid(sFileName, iPos + 1, Len(sFileName) - iPos - 4)
   
    '设置其 Application 属性，显示 Microsoft Excel。
    '然后使用 MyXL 对象引用的 Windows 集合
    '显示包含该文件的实际窗口。
    MyXL.Application.Visible = True
    MyXL.Application.ScreenUpdating = True
    MyXL.Parent.Windows(1).Activate
    MyXl.Application.Sheets(1).Visible=true
End Sub

'关闭Excel
Sub CloseExcel()
    On Error Resume Next
    MyXL.Application.DisplayAlerts = False
    'MyXL.Application.Save
    MyXL.Application.Quit
'    Set MyXL = Nothing    '释放对该应用程序
End Sub

 

使用说明：

   1、新建一个模块，将上述代码复制到新建的模块；

   2、在D:\建立一个Excel文件，命名为Stock.xls

   3、在D:\建立一个StockCode.ini文件，设置需要导出的代码，格式如下：

     [Stock]
     StockCount=5           

     Code1=TWGD
     Market1=XH

     Code2=XHAP
     Market2=XH

     Code3=XHGT
     Market3=XH

     Code4=XHPD
     Market4=XH

     Code5=XHGT
     Market5=XH

     ...

    说明：StockCount=5那行指定要导出的期货品种数

            下面的Code1是第一个品种的代码，Market1是该商品的市场代码，以下代码依次按照序号往下编排。

 

 

使用此模块可以同时导出15个左右品种的行情数据，每0.5秒导出一次，品种再多的话，可能会出现延时现象，我试过使用多个计时器同时导出，每一个计时器导出10个品种，可以减小延时现象，但是会出现运行不稳定，运行10几分钟就自动停止，如果金字塔的VBA后台能支持多线程，可能就可以很好的解决这个问题。

 

请教版主：按照上面所说的操作，消息窗口显示：正在导出：行情；EXCEL也打开了，就是没有具体文件打开和显示，不知道问题出在哪里？

先打开Excel文件，再启动金字塔就行了。

 

好像还是不行，EXCEL里面还是没有信息； 1、ini文件我是用记事本方式建立的，是不是对？/ 2、另外如果我要取IF1106数据，品种的代码：IF，商品的市场代码：IF06，是吗？如下 [Stock] StockCount=10 Code1=IF Market1=IF01 Code2=IF Market2=IF02 Code3=IF Market3=IF00 Code4=CU Market4=CU00 Code5=CU Market5=CUO8 谢谢斑竹

我发现导入数据的时候，也存在问题

Code1=IF06

Market1=ZJ

 

股指市场代码都是ZJ

 

可以把本地的实时数据库,通过SQL实时的导入到金字塔来吗?

好像不能导入数据吧，只能导出数据。

 

很好用，使用 将指定期货最新行情数据写入Excel的代码后，确实能成功的导出数据来。但是遇到一个问题。就是我在使用excel其他文件时，若同时运行该程序，就会在其他的excel文件中也出现导出的数据，数据位置与Stock.xls的一样。这样就使得其他excel文件出错。能不能在程序中设定一下数据只导到Stock.xls中，对其他excel文件不产生影响？否则在使用该程序时，电脑只能打开一个excel文件，其他都不能做了。谢谢哈