返回列表 上一主題 發帖

[原創] 集保資料(改版後)

謝謝版主開版,程式我有拿來改後使用
但上星期(11109)集保的網站改版了
我自己改不出來抓取,能否改一下呢
DINO

TOP

回復 22# quickfixer


    感謝回復…但我後來用的抓法,好像不太一樣,我用WinHttp 似乎快很多。 我把我用的程式貼在下面新的一則貼文
DINO

TOP

我的程式,一次會抓取一年下來的TDCC 資料
不曉得這次改版後,我的程式那邊對應不到,

Sub GoTDCC1yr()
'
' GoTDCC1yr Macro
'
Dim TWYear, CEYear As String
    For m = 1 To 51
        Dim WinHttp As Object, DOM As Object, Table As Object
        Dim url As String, Title() As String, Stockid As String, weekDate As String
        Dim i As Integer, j As Integer

        TWYear = Sheets("三大法人").Cells(m, "O") '民國年日期
        CEYear = Sheets("三大法人").Cells(m, "P")  '西元年日期
        Sheets(TWYear).Activate
StartTDCC:
        Stock = Worksheets("三大法人").Range("M1").Value  '股票代碼
        weekDate = Sheets("三大法人").Cells(m, "P")   '西元年日期 tdcc 用西元年月日
        url = "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock"  ' 改這樣是否正確?
        '  url = "https://www.tdcc.com.tw/smWeb/QryStockAjax.do"    原本url

        Set WinHttp = CreateObject("winhttp.winhttprequest.5.1")
        Set DOM = CreateObject("htmlfile")

        With WinHttp                                    '這裡不知如何改對應這次的改版
            .Open "POST", url, False
            .setrequestheader "Content-Type", "application/x-www-form-urlencoded"
            .send "scaDate=" & weekDate & "&clkStockNo=" & Stock & "&REQ_OPR=SELECT"
        
            If .Status = 200 Then
                DOM.body.innerHTML = .responsetext
            End If
        End With

        Set Table = DOM.getElementsByTagName("table")
        i = 1
        For Each tr In Table(6).Rows                                                     ' 還是回傳資料要改?
            j = 1
            For Each td In tr.Cells
                Sheets(TWYear).Cells(i, j) = td.innerText
                j = j + 1
            Next
            i = i + 1
        Next
   
        i = 2
        For Each tr In Table(7).Rows
            j = 1
            For Each td In tr.Cells
                Sheets(TWYear).Cells(i, j) = td.innerText
                j = j + 1
            Next
            i = i + 1
        Next
   
        Set Table = Nothing
        Set DOM = Nothing
        Set WinHttp = Nothing
              
    Next
   
End Sub
DINO

TOP

        靜思自在 : 知識要用心體會,才能變成自己的智慧。
返回列表 上一主題