打印本文
關閉窗口
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文件，再啟動金字塔就行了。