|
說明:
資料來源
http://www.wretch.cc/blog/eagle99/11079297
原作:黃魯克
他說程式可以散布。
我改了好幾版,有一陣子可以用,後來又變的怪怪的。
把檔案放上來,
有興趣可以研究看看。
它會自動抓證交所和OTC的檔案。
然後切一切放進資料庫,最後可用查詢來把你要的檔案找出來。
既然amibroker的選股能力這麼強,
我想這個程式的用途可能就給大家參考一下怎麼parse 證交所及OTC的資料吧。
==========================================
980113-股票程式-轉入上市櫃檔案V2
本程式將每日由證交所與櫃買中心下載的csv檔直接轉入Access資料庫,因為該csv檔並非固定欄位格式,所以必須由程式自動判斷處理。本程式為全自動,不需手動修改原檔案即可匯入。此部分程式可以獨立出來供各位網友使用。有興趣者請下載 stkbb.zip
該壓縮檔內附csv檔,打開mdb後,直接在[巨集]執行[匯入上市櫃盤後行情],記住先將csv檔COOY到程式下子目錄import。
本程式可一次處理多個csv檔,記住每個上櫃的csv檔都必須以RSTA開頭,每個上市的csv檔必須以A11開頭,用來區分上市與上櫃(兩者格式不同)
你必須先將csv檔copy 到程式下/import子目錄,處理完後檔案會移到/complete子目錄,你可以將上市與上櫃的檔案同時放入/import中同時處理。
本程式同時更新股票代碼檔。
「每日盤後」資訊可在證交所與櫃買中心免費取得。如下:
上市
證券交易所 http://www.twse.com.tw/
首頁 > 交易資訊 > 盤後資訊 >每日收盤行情
櫃檯
台灣櫃買中心 http://www.gretai.org.tw/ch/index.php
首頁 > 上櫃股票交易資訊 > 盤後資訊 > 上櫃股票行情
--------------------------------------------------------------------------------
Function importDaily()
Call A11Import
Call RSTAImport
End Function
--------------------------------------------------------------------------------
Function RSTAimp1(source)
' --- 匯入一個上櫃csv檔到主檔stk
Dim fs2 As New Scripting.FileSystemObject
Dim RsStk As Recordset
Dim RsStkId As Recordset
Dim inpFi As TextStream
Dim lines As Integer
Dim s1 As String
Dim yy As String, mm As String, dd As String
Dim sdate As String
Dim aa
Dim i As Integer
Dim s2 As String
Dim isdel As Boolean
Dim ch
Set inpFi = fs2.OpenTextFile(source)
Set RsStk = CurrentDb.OpenRecordset("select * from stk")
lines = 0
Do While Not inpFi.AtEndOfStream
lines = lines + 1
s1 = inpFi.ReadLine
If lines = 1 Then
yy = Mid(s1, 1, 2)
mm = Mid(s1, InStr(s1, "年") + 1, 2)
dd = Mid(s1, InStr(s1, "月") + 1, 2)
sdate = (1911 + yy) & "/" & mm & "/" & dd
Debug.Print sdate
End If
If InStr(s1, "上櫃家數") <> 0 Then
Exit Do
End If
If lines >= 3 Then
'**************************************
isdeli = False
s2 = ""
For i = 1 To Len(s1)
ch = Mid(s1, i, 1)
If Mid(s1, i, 1) = """" Then
isdeli = Not isdeli
Else
If isdeli Then
If ch <> "," Then
s2 = s2 & ch
End If
Else
s2 = s2 & ch
End If
End If
Next
s2 = Replace(s2, "--", "00")
'Debug.Print s2
'*************************************
aa = Split(s2, ",")
If UBound(aa) < 9 Then
Debug.Print s1
ElseIf Len(aa(0)) = 4 Then
'代號0,名稱1,收盤2 ,漲跌3,開盤4 ,最高5 ,最低6,均價7 ,成交股數8
RsStk.AddNew
RsStk("dte") = CDate(sdate)
RsStk("stockid") = aa(0)
RsStk("price") = aa(2)
RsStk("p_open") = aa(4)
RsStk("p_high") = aa(5)
RsStk("p_low") = aa(6)
s2 = Replace(aa(8), ",", "")
s2 = Replace(s2, """", "")
RsStk("vol") = s2
RsStk.Update
'--- 同時更新股票代號檔
Set RsStkId = CurrentDb.OpenRecordset("select * from stkid where stockid='" & aa(0) & "'")
If RsStkId.EOF Then
DoCmd.RunSQL ("insert into stkid values('" & aa(0) & "','" & aa(1) & "','2')")
End If
End If
End If
Loop
RsStk.Close
Debug.Print source
End Function
--------------------------------------------------------------------------------
Function RSTAImport()
'--- 將dirImport內的所有 RSTA*.csv上櫃檔匯入到主檔 stk,同時將該檔移到 dircomplete
Dim fs As New Scripting.FileSystemObject
Dim outFi As TextStream, errFi As TextStream
Dim dirImport As String, dirComplete As String
Dim fi As File
Dim strRoot As String
Dim fo_root As Folder
Dim fo_Dir As Folder
Dim ext As String
Dim source As String, Target As String, stockId As String
strRoot = CurrentProject.path
dirImport = strRoot & "\import"
dirComplete = strRoot & "\complete"
Set outFi = fs.CreateTextFile(strRoot & "\" & "log.txt", True)
Set errFi = fs.CreateTextFile(strRoot & "\" & "errlog.txt", True)
Set fo_root = fs.GetFolder(strRoot)
If Not fs.FolderExists(dirImport) Then
MsgBox "請將欲轉入之xls 放在" & dirImport
Exit Function
End If
If Not fs.FolderExists(dirComplete) Then
fs.CreateFolder (dirComplete)
End If
Set fo_Dir = fs.GetFolder(dirImport)
For Each fi In fo_Dir.Files
ext = Mid(fi.Name, InStr(fi.Name, "."), 4)
If Left(fi.Name, 4) = "RSTA" And LCase(ext) = ".csv" Then
Debug.Print fi.Name
source = fi.path
Target = dirComplete & "\" & fi.Name
fs.CopyFile source, Target, True
Call RSTAimp1(source)
fs.DeleteFile source
End If
Next
outFi.Close
errFi.Close
Debug.Print "Done!RSTA*.csv Import" & vbCrLf & " 檔案已經搬移到" & dirComplete
End Function
--------------------------------------------------------------------------------
Function A11imp1(source)
' --- 匯入一個上櫃csv檔到主檔stk
Dim fs2 As New Scripting.FileSystemObject
Dim RsStk As Recordset
Dim RsStkId As Recordset
Dim inpFi As TextStream
Dim s1 As String
Dim yy As String, mm As String, dd As String
Dim sdate As String
Dim aa
Dim i As Integer
Dim s2 As String
Dim isBegin As Boolean
Dim isdelim As Boolean
Dim lines, ch
Set inpFi = fs2.OpenTextFile(source)
Set RsStk = CurrentDb.OpenRecordset("select * from stk")
isBegin = False
lines = 0
Do While Not inpFi.AtEndOfStream
s1 = inpFi.ReadLine
If Not isBegin And InStr(s1, "每日收盤行情") <> 0 Then
isBegin = True
yy = Mid(s1, 1, 2)
mm = Mid(s1, InStr(s1, "年") + 1, 2)
dd = Mid(s1, InStr(s1, "月") + 1, 2)
sdate = (1911 + yy) & "/" & mm & "/" & dd
Debug.Print sdate
inpFi.SkipLine ' 標題欄
ElseIf isBegin Then
'--- 解決字串中的,號,如"200,450,000"==> 200450000
If Mid(s1, 1, 1) > "0" Then
lines = lines + 1
'If lines > 5 Then
' Exit Do
'End If
'**************************************
isdeli = False
s2 = ""
For i = 1 To Len(s1)
ch = Mid(s1, i, 1)
If Mid(s1, i, 1) = """" Then
isdeli = Not isdeli
Else
If isdeli Then
If ch <> "," Then
s2 = s2 & ch
End If
Else
s2 = s2 & ch
End If
End If
Next
s2 = Replace(s2, "--", "00")
'Debug.Print s2
'*************************************
aa = Split(s2, ",")
If UBound(aa) < 8 Or Len(aa(0)) > 4 Then
'Debug.Print s2
Else
'證券代號0,證券名稱1,成交股數2,成交筆數3,成交金額4,開盤價5,最高價6,最低價7,收盤價8
RsStk.AddNew
RsStk("dte") = CDate(sdate)
RsStk("stockid") = aa(0)
RsStk("price") = "0" & aa(8)
RsStk("p_open") = aa(5)
RsStk("p_high") = aa(6)
RsStk("p_low") = aa(7)
s2 = Replace(aa(2), ",", "")
s2 = Replace(s2, """", "")
RsStk("vol") = s2
RsStk.Update
'--- 同時更新股票代號檔
Set RsStkId = CurrentDb.OpenRecordset("select * from stkid where stockid='" & aa(0) & "'")
If RsStkId.EOF Then
DoCmd.RunSQL ("insert into stkid values('" & aa(0) & "','" & aa(1) & "','1')")
End If
End If
End If
End If
Loop
RsStk.Close
Debug.Print source
End Function
--------------------------------------------------------------------------------
Function A11Import()
'--- 將dirImport內的所有 A11*.csv上市檔匯入到主檔 stk,同時將該檔移到 dircomplete
Dim fs As New Scripting.FileSystemObject
Dim outFi As TextStream, errFi As TextStream
Dim dirImport As String, dirComplete As String
Dim fi As File
Dim strRoot As String
Dim fo_root As Folder
Dim fo_Dir As Folder
Dim ext As String
Dim source As String, Target As String, stockId As String
strRoot = CurrentProject.path
dirImport = strRoot & "\import"
dirComplete = strRoot & "\complete"
Set outFi = fs.CreateTextFile(strRoot & "\" & "log.txt", True)
Set errFi = fs.CreateTextFile(strRoot & "\" & "errlog.txt", True)
Set fo_root = fs.GetFolder(strRoot)
If Not fs.FolderExists(dirImport) Then
MsgBox "請將欲轉入之xls 放在" & dirImport
Exit Function
End If
If Not fs.FolderExists(dirComplete) Then
fs.CreateFolder (dirComplete)
End If
Set fo_Dir = fs.GetFolder(dirImport)
For Each fi In fo_Dir.Files
ext = Mid(fi.Name, InStr(fi.Name, "."), 4)
If Left(fi.Name, 3) = "A11" And LCase(ext) = ".csv" Then
Debug.Print fi.Name
source = fi.path
Target = dirComplete & "\" & fi.Name
fs.CopyFile source, Target, True
Call A11imp1(source)
fs.DeleteFile source
End If
Next
outFi.Close
errFi.Close
Debug.Print "Done!A11*.csv Import" & vbCrLf & " 檔案已經搬移到" & dirComplete
End Function
End Function
stkbb_nodata.zip
(3.78 MB, 下載次數: 3520)
|
|