ƨӷ
http://www.wretch.cc/blog/eagle99/11079297
==========================================

980113-Ѳ{-JWdɮV2

{NCҥһPdRߤUcsvɪJAccessƮwA]csvɨëDTw榡AҥHѵ{۰ʧP_BzC{۰ʡAݤʭקɮקYiפJC{iHWߥXӨѦUͨϥΡC̽ФU stkbb.zip

YɤcsvɡA}mdbAb[][פJWdL污]AONcsvCOOY{UlؿimportC

{i@BzhcsvɡAOCӤWdcsvɳHRSTA}YACӤWcsvɥHA11}YAΨӰϤWPWd(̮榡P)

ANcsvcopy {U/importlؿABzɮ׷|/completelؿAAiHNWPWdɮצPɩJ/importPɳBzC

{PɧsѲNXɡC

uCLvTibҥһPdRߧKOoCpUG

W

Ҩ http://www.twse.com.tw/ 

 > T > LT >C馬L污

di

xWdR http://www.gretai.org.tw/ch/index.php

 > WdѲT > LT > WdѲ污

 


--------------------------------------------------------------------------------

Function importDaily()
    Call A11Import
    Call RSTAImport
End Function


--------------------------------------------------------------------------------

Function RSTAimp1(source)
' --- פJ@ӤWdcsvɨDstk
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, "Wda") <> 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
            'N0,W1,L2 ,^3,}L4 ,̰5 ,̧C6,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
                '--- PɧsѲN
                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()
'--- NdirImportҦ RSTA*.csvWdɶפJD stkAPɱNɲ 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 "бNJxls b" & 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 & " ɮפwgh" & dirComplete

End Function





--------------------------------------------------------------------------------

Function A11imp1(source)
' --- פJ@ӤWdcsvɨDstk
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, "C馬L污") <> 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        ' D
    ElseIf isBegin Then
           
        '--- ѨMrꤤ,Ap"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
            
            'ҨN0,ҨW1,Ѽ2,浧3,B4,}L5,̰6,̧C7,L8
                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
                '--- PɧsѲN
                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()
'--- NdirImportҦ A11*.csvWɶפJD stkAPɱNɲ 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 "бNJxls b" & 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 & " ɮפwgh" & dirComplete

End Function


End Function

