ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

¤U¸üºô­¶¤º®e¥X²{¿ù»~ ¦b¦¹¤º®e¤¤¤£¤¹¾Þ§@

¤U¸üºô­¶¤º®e¥X²{¿ù»~ ¦b¦¹¤º®e¤¤¤£¤¹¾Þ§@

Private Sub CommandButton1_Click()

Dim starttime As Variant
Dim fountrow As Integer, col As Integer, topic As Integer, row As Integer

starttime = Now()

'Application.ScreenUpdating = False ' Ãö³¬¿Ã¹õ§ó·s¡A¥[§Ö³t«×¡C

    Set XML = CreateObject("Microsoft.XMLHTTP")
    Set Stream = CreateObject("ADODB.stream")
    Dim path As String, thePOSTdata, URL
    Dim stockID()
    col = 0
    row = 1
    topic = 0
    stockID = Array(2605, 2606, 2607, 2608)
    URL = "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/STOCK_DAYMAIN.php"
    For x = 0 To UBound(stockID)
        For y = 2014 To 2016
            For z = 1 To 12
                If xlYear = 2016 And xlMonth = 11 Then       '¶W¹L¥Ø«e¤é´Á«h¸õ¥X°j°é
                    Exit For
                End If
                thePOSTdata = "download=csv&query_year=" & y & "&query_month=" & z & "&CO_ID=" & stockID(x)
                XML.Open "POST", URL, 0
                XML.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
                XML.send thePOSTdata
        
                With Stream
               
                    .Type = 1
                    .Mode = 3
                    .Open
                    .Write XML.responseBody
                    .Position = 0
                    .Type = 2
                    .Charset = "Big5"
                    ByteToText = .ReadText
                    'MsgBox ByteToText

                    Dim arr() As String
   
                    arr = Split(ByteToText, Chr(10))       'Chr(10)¥NªíEnterÁä¶Ü???
   
                    Dim processstring As String
   
                    For i = 0 To UBound(arr)
                        'MsgBox arr(i)
                        processstring = Replace(arr(i), """,""", "^^")
   
                        'putdata = Split(arr(i), "^^")
                        putdata = Split(processstring, "^^")
                        'If Not (topic = 1 And i = 0) Then
         
                            For j = 0 To UBound(putdata)
                                'Sheets(i).Cells(65536, col).End(xlUp).Offset(1, 0)
                                Sheets(2).Cells(row, j + 1 + col).NumberFormatLocal = "@"
                                '¤u§@ªí1.Cells(i + 1, j + 1).Value = CStr(Replace(Replace(putdata(j), """", ""), "=", ""))
                                'MsgBox putdata(j)
                                ShowString = Replace(Trim(putdata(j)), ",", "")
                                ShowString = Replace(ShowString, """", "")
                                ShowString = Replace(ShowString, "=", "")
                                Sheets(2).Cells(row, j + 1 + col).Value = ShowString
                                'If j = 1 Then
                                '    topic = 1
                                'End If
                                
            
                            Next j
                            row = row + 1
                        'End If
                        
                    Next i

                End With
        
   
            Next
        Next
        col = col + 10
        row = 1
        topic = 0
    Next
   
End Sub

Type = 1³Q¼Ð°O¦¨¶À¦â¡A½Ð°Ý°ª¤â¨ì©³­þ¸Ì¥X¿ù

¤w¸Ñ¨M   ÁÂÁ¤j®a

TOP

        ÀR«ä¦Û¦b : °µ¦n¨Æ¤£¯à¤Ö§Ú¤@¤H¡A°µÃa¨Æ¤£¯à¦h§Ú¤@¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD