- 帖子
- 4
- 主題
- 0
- 精華
- 0
- 積分
- 53
- 點名
- 0
- 作業系統
- Windows7
- 軟體版本
- Office 2003
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2012-1-18
- 最後登錄
- 2023-10-5
|
我的程式,一次會抓取一年下來的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 |
|