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是该商品的市场代码,以下代码依次按照序号往下编排。
|