This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
' 由證交所與櫃買中心下載的csv檔直接轉入Access資料庫 | |
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 |