標題: 證交所抓個股日成交資訊 [打印本頁]

---

作者: tsunamix03    時間: 2021-9-9 11:43     標題: 證交所抓個股日成交資訊

之前抓取證交所的資料沒有問題

但是現在會出現「系統找不到指定的資源」，然後停在「XML.send thePOSTdata」這行程式碼

找不到錯誤出在哪

謝謝各位大大了


Sub 按鈕1_Click()

Dim starttime As Variant
Dim fountrow As Integer

starttime = Now()

'Application.ScreenUpdating = False ' 關閉螢幕更新，加快速度。

    Set XML = CreateObject("Microsoft.XMLHTTP")
    Set Stream = CreateObject("ADODB.stream")
    Dim path As String, thePOSTdata, URL


    URL = "https://twse.com.tw/zh/page/trading/exchange/STOCK_DAY.html"
    thePOSTdata = "download=csv&query_year=2020&query_month=10&CO_ID=2330"
        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)代表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, "^^")
        


        For j = 0 To UBound(putdata)
            Sheets(1).Cells(i + 1, j + 1).NumberFormatLocal = "@"
            '工作表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(1).Cells(i + 1, j + 1).Value = ShowString
            
        Next j
    Next i

End With
End Sub

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)